Attribute VB_Name = "modBillingCA"
Option Explicit

Public DefaultDepartmentCode As String
Public DefaultDepartmentDesc As String

Private GotMarkupSettings As Boolean

Public Function Get_MarkUpSettingsCA(Optional Force As Boolean)

    If Force = False Then
        If GotMarkupSettings = True Then
            Exit Function
        Else
            GotMarkupSettings = True
        End If
    End If
    
    Dim RecX As New ADODB.Recordset
    Dim strSQL As String
    Dim intQ As Integer

    On Error GoTo ErrTrap
'    search = "Select isnull(isAllowAfterFivePMRate, 0)isAllowAfterFivePMRate, isnull(isAllowHolidayRate,0)isAllowHolidayRate, " & _
'               "isnull(isAllowNewStatRate,0) isAllowNewStatRate, isnull(isAllowWeekendRate,0) isAllowWeekendRate, isnull(isAllowAfterFiveLabChemOnly,0) isAllowAfterFiveLabChemOnly, " & _
'               "isnull(isAllowAfterFiveAllRevenues, 0) isAllowAfterFiveAllRevenues from Clinical_Area..tbGenericModuleSettings WITH (NOLOCK)"

    strSQL = "Select * from Clinical_Area..tbGenericModuleSettings WITH (NOLOCK)"
    
    With RecX
        If .State > 0 Then .Close
        '.CursorLocation = adUseClient
        
        .Open strSQL, pclsUser.sqlconnection, adOpenStatic, adLockReadOnly
        
        If .EOF = False Then
            isAllowAfterFivePMRate = IIf(!isAllowAfterFivePMRate = 0, False, True)
            isAllowHolidayRate = IIf(!isAllowHolidayRate = 0, False, True)
            isAllowNewStatRate = IIf(!isAllowNewStatRate = 0, False, True)
            isAllowWeekendRate = IIf(!isAllowWeekendRate = 0, False, True)
            isAllowAfterFiveLabChemOnly = IIf(!isAllowAfterFiveLabChemOnly = 0, False, True)
            isAllowAfterFiveAllRevenues = IIf(!isAllowAfterFiveAllRevenues = 0, False, True)
            dtWeekendStartMarkup = IIf(!dtWeekendStartMarkup = Null, "12:01:00", "12:01:00")
            dtWeekendEndMarkup = IIf(!dtWeekendEndMarkup = Null, "11:59:59", "11:59:59")
            
            HolidayRate = !HolidayRate
            AfterFivePmRate = !AfterFivePmRate
            WeekendRate = !WeekendRate
            HolidayAndWeekendRate = !HolidayAndWeekend
            HolidayAndAfterFivePmRate = !HolidayAndAfterFivePmRate
            AfterFiveAndWeekend = !WeekendAfterFive
            MaxMarkupRate = !MaxMarkupRate
            
'            frmPatInfo.Grid1.Rows = 0
'            frmPatInfo.Grid1.AddItem "isAllowAfterFivePMRate" & vbTab & isAllowAfterFivePMRate
'            frmPatInfo.Grid1.AddItem "isAllowHolidayRate" & vbTab & isAllowHolidayRate
'            frmPatInfo.Grid1.AddItem "isAllowNewStatRate" & vbTab & isAllowNewStatRate
'            frmPatInfo.Grid1.AddItem "isAllowWeekendRate" & vbTab & isAllowWeekendRate
'            frmPatInfo.Grid1.AddItem "isAllowAfterFiveLabChemOnly" & vbTab & isAllowAfterFiveLabChemOnly
'            frmPatInfo.Grid1.AddItem "isAllowAfterFiveAllRevenues" & vbTab & isAllowAfterFiveAllRevenues
'            frmPatInfo.Grid1.AddItem "dtWeekendStartMarkup" & vbTab & dtWeekendStartMarkup
'            frmPatInfo.Grid1.AddItem "dtWeekendEndMarkup" & vbTab & dtWeekendEndMarkup
'            frmPatInfo.Grid1.AddItem "HolidayRate" & vbTab & HolidayRate
'            frmPatInfo.Grid1.AddItem "AfterFivePmRate" & vbTab & AfterFivePmRate
'            frmPatInfo.Grid1.AddItem "WeekendRate" & vbTab & WeekendRate
'            frmPatInfo.Grid1.AddItem "HolidayAndWeekendRate" & vbTab & HolidayAndWeekendRate
'            frmPatInfo.Grid1.AddItem "HolidayAndAfterFivePmRate" & vbTab & HolidayAndAfterFivePmRate
'            frmPatInfo.Grid1.AddItem "AfterFiveAndWeekend" & vbTab & AfterFiveAndWeekend
'            frmPatInfo.Grid1.AddItem "MaxMarkupRate" & vbTab & MaxMarkupRate
            
        End If
        .Close
    End With
    
    Set RecX = Nothing

    Exit Function
ErrTrap:
    MsgBox "Get_MarkUpSettings " & Err.Description
    Resume Next
End Function
 
Public Sub ComputeRateCA()  'NewShowAmount
    Dim dblAmount As Double
    Dim intA As Integer
    Dim strQuery As String
    Dim strSQL As String
    Dim RecX As New ADODB.Recordset
    Dim mytype As String
    
    Dim FirstRate As Double


    With frmPostCharge.grdTable
        If frmPostCharge.chkStat.Value = 1 Then ''''if stat
             For intA = 1 To .Rows - 1
                If .TextMatrix(intA, coItemID) <> "" Then
                    If .TextMatrix(intA, coDepartment) <> "MD" Then
                        mytype = pclsUser.medsysclassesmyClsBilling.Get_strType
                        If mytype = "X" Then ''no added mark up rate
                            dblAmount = Val(.TextMatrix(intA, coQuantity)) * Val(.TextMatrix(intA, coPrice)) + (Val(.TextMatrix(intA, coQuantity)) * Val(.TextMatrix(intA, coPrice)) * Val(dblStatRate) / 100)
                            .TextMatrix(intA, coAmount) = Format(dblAmount, "######0.00")
                        ElseIf mytype = "2" Then ''stat and after five pm rate
                            dblAmount = Val(.TextMatrix(intA, coQuantity)) * Val(.TextMatrix(intA, coPrice)) + (Val(.TextMatrix(intA, coQuantity)) * Val(.TextMatrix(intA, coPrice)) * Val(StatAndAfterFivePmRate) / 100)
                            .TextMatrix(intA, coAmount) = Format(dblAmount, "######0.00")
                        ElseIf mytype = "3" Then  ''stat and weekend rate
                            dblAmount = Val(.TextMatrix(intA, coQuantity)) * Val(.TextMatrix(intA, coPrice)) + (Val(.TextMatrix(intA, coQuantity)) * Val(.TextMatrix(intA, coPrice)) * Val(StatAndWeekendRate) / 100)
                            .TextMatrix(intA, coAmount) = Format(dblAmount, "######0.00")
                        Else '' stat rate and any markup rates = maxrate
                            FirstRate = pclsUser.medsysclassesmyClsBilling.get_FirstRate(.TextMatrix(intA, coDepartment), (.TextMatrix(intA, coItemID)))
                            dblAmount = Val(.TextMatrix(intA, coQuantity)) * Val(FirstRate) + ((Val(.TextMatrix(intA, coQuantity)) * Val(FirstRate) * Val(MaxMarkupRate) / 100))
                            .TextMatrix(intA, coAmount) = Format(dblAmount, "######0.00")
                        End If
                        If isRequest = False Then
                            .TextMatrix(.Row - (intA), coStat) = "Y"
                        Else
                            .TextMatrix(intA, coStat) = "Y"
                        End If
                    Else
                        .TextMatrix(intA, coAmount) = Format(.TextMatrix(intA, coAmount), "######0.00")

                    End If
                End If
        Next

        Else   ''' if not stat - unchecked stat button
            For intA = 1 To .Rows - 1

                If .TextMatrix(intA, coItemID) <> "" Then
                   If .TextMatrix(intA, coDepartment) <> "MD" Then
                    dblAmount = Val(.TextMatrix(intA, coQuantity)) * Val(.TextMatrix(intA, coPrice)) '4 = price, 5=quantity
                    .TextMatrix(intA, coAmount) = Format(dblAmount, "0.00")
                    .TextMatrix(intA, coStat) = "N"
                   Else
                    .TextMatrix(intA, coAmount) = Format(.TextMatrix(intA, coAmount), "0.00")
                   End If
                End If
            Next
            End If
        End With
    Set RecX = Nothing
End Sub

Public Sub CancelChargesCA()

    With frmPostCharge

    Dim recUpdateArCode As New ADODB.Recordset
    Dim strUpdaterecArcode As String
    Dim strAmt As String
    Dim recCancel As New ADODB.Recordset
    Dim intZero As Double
    Dim tmpRevenueID As String
    Dim strPType As String

    .cmdReprint.Visible = True
    .cmdCancelCharge.Visible = True

    'Verify if can cancel the charge
    intZero = 0#
    recCancel.Open "Clinical_Area..spGeneric_CancelCharges '" & .myclsbilling.MyclsPatient.IdNum & "','" & .mshflexList.TextMatrix(.mshflexList.Row, 2) & "','" & .mshflexList.TextMatrix(.mshflexList.Row, 6) & "','" & .mshflexList.TextMatrix(.mshflexList.Row, 1) & "'", pclsUser.sqlconnection, adOpenForwardOnly, adLockOptimistic
    If Not recCancel.EOF Then
        If recCancel!Amount <= intZero Then
            MsgBox "Can't Cancel this Charges. The Total Amount is already Zero!", vbCritical + vbOKOnly, "Message"
            recCancel.Close
            Set recCancel = Nothing
            Exit Sub
        End If
        recCancel.Close
        Set recCancel = Nothing
    End If
    If MsgBox("Are you sure you want to Cancel this Charge?", vbQuestion + vbYesNo) = vbYes Then
    Else
        'Me.tmrTimer.Enabled = True
        Exit Sub
    End If

    With frmPostCharge
        strAmt = .mshflexList.TextMatrix(.mshflexList.Row, 5)

        recUpdateArCode.Open "station..sp_OPD_ArCode'" & .mshflexList.TextMatrix(.mshflexList.Row, 1) & "'", pclsUser.sqlconnection, adOpenStatic, adLockOptimistic
        If Not recUpdateArCode.EOF Then
            strUpdaterecArcode = IIf(IsNull(recUpdateArCode!cmcode), "", recUpdateArCode!cmcode)
        End If

        If Trim$(.mshflexList.TextMatrix(.mshflexList.Row, 9)) <> "" Then
            tmpRevenueID = Get_StockCardRevenueID(Trim$(.mshflexList.TextMatrix(.mshflexList.Row, 1)))
        End If

        If .mshflexList.TextMatrix(.mshflexList.Row, 9) <> "" Then
            pclsUser.medsysclasses.clsDrug.Drug.AppendStockCard .txtPno.Text, _
                .myclsbilling.MyclsPatient.IdNum, _
                .mshflexList.TextMatrix(.mshflexList.Row, 2), _
                Format(pclsUser.medsysclasses.Get_TransactionDate, "mm/dd/yyyy hh:mm:ss AM/PM"), _
                .mshflexList.TextMatrix(.mshflexList.Row, 6), _
                Val(.mshflexList.TextMatrix(.mshflexList.Row, 4) * (-1)), _
                0, _
                Val(.mshflexList.TextMatrix(.mshflexList.Row, 5) * (-1)), _
                pclsUser.EmployeeCode, _
                "", _
                "", _
                .mshflexList.TextMatrix(.mshflexList.Row, 9), _
                "", _
                .myclsbilling.MyclsPatient.Room, _
                1, _
                tmpRevenueID, tmpRevenueID, , , , , "O", , , , 0
            'IIf(.TextMatrix(.Row, 1) = "CS" Or .TextMatrix(.Row, 1) = "OS" Or .TextMatrix(.Row, 1) = "DZ" Or .TextMatrix(.Row, 1) = "FF", "CS", "PH"), _
             'IIf(.TextMatrix(.Row, 1) = "CS" Or .TextMatrix(.Row, 1) = "OM" Or .TextMatrix(.Row, 1) = "DA" Or .TextMatrix(.Row, 1) = "FF", "PH", "CS"), , , , , "O", , , , 0

        Else
            If Check_WithDiscount(Trim$(.mshflexList.TextMatrix(.mshflexList.Row, 6)), Trim$(.myclsbilling.MyclsPatient.IdNum)) Then
             pclsUser.sqlconnection.Execute "Patient_data..opd_autorecompute_discount '" & .mshflexList.TextMatrix(.mshflexList.Row, 6) & _
             "','" & .myclsbilling.MyclsPatient.IdNum & "','" & strAmt & "'"
            End If
            
            
            If Right(.myclsbilling.MyclsPatient.IdNum, 1) = "B" Then
                strPType = "O"
            Else
                strPType = "I"
            End If
            
            pclsUser.sqlconnection.Execute "STATION..OPDRegistration_UpdateCharging '" & .txtPno.Text & _
                "','" & .myclsbilling.MyclsPatient.IdNum & "','" & .mshflexList.TextMatrix(.mshflexList.Row, 2) & _
                "','" & strAmt & "','" & .mshflexList.TextMatrix(.mshflexList.Row, 4) & _
                "','" & Format$(pclsUser.medsysclasses.Get_TransactionDate, "MM/DD/YYYY hh:mm:ss AM/PM") & "','" & .mshflexList.TextMatrix(.mshflexList.Row, 1) & _
                "','" & pclsUser.EmployeeCode & "','" & strPType & _
                "','" & "C" & "','" & .myclsbilling.MyclsPatient.Room & _
                "','" & .mshflexList.TextMatrix(.mshflexList.Row, 6) & "','" & strUpdaterecArcode & "'"
        End If
    End With
    .mshflexList.Refresh
    '.Get_Charges
    
    End With
    
    Exit Sub
    
End Sub

Public Function Get_PatientType(strIDNum As String, strType As String, strRoomId As String) As String
    Dim recIsSpecial As New ADODB.Recordset

    Get_PatientType = "A"
    recIsSpecial.Open "Clinical_Area..sp_Generic_Get_PatientType '" & Trim$(strIDNum) & "','" & Trim$(strType) & "'", pclsUser.sqlconnection, adOpenForwardOnly, adLockReadOnly

    If Not recIsSpecial.EOF Then
        If recIsSpecial!isspecial = 0 Then
            If strType = "O" Then
                Get_PatientType = "A"
            Else
                Get_PatientType = Get_RoomClassification(strRoomId)
            End If
        Else
            If recIsSpecial!isspecial = 1 Then
                Get_PatientType = "F"
            Else
                If recIsSpecial!isspecial = "9" Then
                    Get_PatientType = "F"
                Else
                    Get_PatientType = Get_RoomClassification(strRoomId)
                End If
            End If
        End If
    End If
    recIsSpecial.Close
    Set recIsSpecial = Nothing

End Function

Public Function Get_RoomClassification(strRoomId As String) As String
    Dim recRoomClass As New ADODB.Recordset
    recRoomClass.Open "STATION..sp_Nurse_Get_RoomClassification '" & Trim$(strRoomId) & "'", pclsUser.sqlconnection, adOpenForwardOnly, adLockReadOnly
    
    If Not recRoomClass.EOF Then
        Get_RoomClassification = UCase(recRoomClass!RoomClassID)
    Else
        Get_RoomClassification = ""
    End If
    recRoomClass.Close
    
    Set recRoomClass = Nothing
End Function


Public Function Check_ProfileExam(strExamID As String, ProFileList As MSHFlexGrid) As Boolean
    Dim recProfile As New ADODB.Recordset


    Check_ProfileExam = False

    recProfile.Open "STATION..sp_Nurse_Get_ProfileList '" & Trim$(strExamID) & "'", pclsUser.sqlconnection, adOpenForwardOnly, adLockReadOnly

    If Not recProfile.EOF Then
        Check_ProfileExam = True
        Do While Not recProfile.EOF
            With ProFileList
                If .TextMatrix(1, 1) = "" Then
                    .TextMatrix(1, 1) = recProfile!ExamID & ""
                    .TextMatrix(1, 2) = recProfile!ExamName & ""
                    .TextMatrix(1, 3) = recProfile!ProfileID & ""
                    .TextMatrix(1, 4) = recProfile!ProfileName & ""
                Else
                    .Rows = .Rows + 1
                    .TextMatrix(.Rows - 1, 1) = recProfile!ExamID & ""
                    .TextMatrix(.Rows - 1, 2) = recProfile!ExamName & ""
                    .TextMatrix(.Rows - 1, 3) = recProfile!ProfileID & ""
                    .TextMatrix(.Rows - 1, 4) = recProfile!ProfileName & ""
                End If
            End With
            recProfile.MoveNext
        Loop
    Else
        Check_ProfileExam = False
    End If

    recProfile.Close
    Set recProfile = Nothing

End Function

Public Function Check_OrderList_InProfileList(ProFileList As MSHFlexGrid, OrderList As MSHFlexGrid, intCol As Integer) As Boolean
    Dim intOrder As Integer
    Dim intProfile As Integer

    Check_OrderList_InProfileList = False

    For intOrder = 1 To OrderList.Rows - 1
        For intProfile = 1 To ProFileList.Rows - 1
            If Trim$(OrderList.TextMatrix(intOrder, intCol)) = Trim$(ProFileList.TextMatrix(intProfile, 1)) Then
                MsgBox "The Exam " & Trim$(ProFileList.TextMatrix(intProfile, 2)) & " in the ORDER LIST is included in this Profile(" & Trim$(ProFileList.TextMatrix(intProfile, 4)) & ")", vbOKOnly + vbExclamation, "Notification"
                Check_OrderList_InProfileList = True
                Exit Function
            Else
                Check_OrderList_InProfileList = False
            End If
        Next
    Next

End Function
'
'Public Sub Remove_Profile_OrderList(ProFileList As MSHFlexGrid, OrderList As MSHFlexGrid, intCol As Integer)
'    Dim intOrder As Integer
'    Dim intProfile As Integer
'
'Routine:
'    For intOrder = 1 To OrderList.Rows - 1
'        For intProfile = 1 To ProFileList.Rows - 1
'            If OrderList.Rows = 2 And OrderList.TextMatrix(1, 1) = "" Then
'            Else
'                If Trim$(ProFileList.TextMatrix(intProfile, 1)) = _
'                   Trim$(OrderList.TextMatrix(intOrder, intCol)) Then
'                    If OrderList.Rows = 2 And OrderList.TextMatrix(1, 1) <> "" Then
'                        If intCol = 2 Then
'                            If Not OrderList.TextMatrix(intOrder, 11) = "" Then
'                                frmFinal.lstListLaboratory.RemoveItem OrderList.TextMatrix(intOrder, 11)
'                                frmFinal.lstListLaboratory.AddItem OrderList.TextMatrix(intOrder, 10)
'                                frmFinal.lstListLaboratory.Refresh
'                            End If
'                        End If
'
'                        With OrderList
'                            .TextMatrix(1, 1) = ""
'                            .TextMatrix(1, 2) = ""
'                            .TextMatrix(1, 3) = ""
'                            .TextMatrix(1, 4) = ""
'                            .TextMatrix(1, 5) = ""
'                            .TextMatrix(1, 6) = ""
'                            .TextMatrix(1, 7) = ""
'                            .TextMatrix(1, 8) = ""
'                            .TextMatrix(1, 9) = ""
'                            .TextMatrix(1, 10) = ""
'                            .TextMatrix(1, 11) = ""
'                            If .Cols > 12 Then
'                                .TextMatrix(1, 12) = ""
'                                .TextMatrix(1, 13) = ""
'                                .TextMatrix(1, 14) = ""
'                                .TextMatrix(1, 15) = ""
'                            End If
'                        End With
'                    Else
'                        If intCol = 2 Then
'                            If Not OrderList.TextMatrix(intOrder, 11) = "" Then
'                                frmFinal.lstListLaboratory.RemoveItem OrderList.TextMatrix(intOrder, 11)
'                                frmFinal.lstListLaboratory.AddItem OrderList.TextMatrix(intOrder, 10)
'                                frmFinal.lstListLaboratory.Refresh
'                            End If
'                        End If
'                        OrderList.RemoveItem (intOrder)
'                        GoTo Routine
'                    End If
'                End If
'            End If
'        Next
'    Next
'
'End Sub

Public Function Check_Exam_InProfileList(strExamID As String, ProFileList As MSHFlexGrid) As Boolean
    Dim intProfile As Integer

    Check_Exam_InProfileList = False

    For intProfile = 1 To ProFileList.Rows - 1
        If Trim$(ProFileList.TextMatrix(intProfile, 1)) = strExamID Then
            MsgBox "This Exam " & Trim$(ProFileList.TextMatrix(intProfile, 2)) & " is included in this Profile(" & Trim$(ProFileList.TextMatrix(intProfile, 4)) & ")", vbOKOnly + vbExclamation, "Notification"
            Check_Exam_InProfileList = True
            Exit Function
        Else
            Check_Exam_InProfileList = False
        End If
    Next

End Function


Public Function Update_Other_Info()
    'REFERENCED BY frmRemarks
    pclsUser.sqlconnection.Execute "STATION..sp_Nurse_Update_OtherInfo '" & myclsbilling.MyclsPatient.IdNum & _
                               "','" & strTransplant & "','" & strDialysis & "','I'"

End Function

Public Function Get_Patient_OtherInfo()

    With frmFinal
    
    Dim recOther As New ADODB.Recordset

    recOther.Open "select isnull(A.transplantID,'0') as transplantID,isnull(A.dialysisID,'0') as dialysisID, " & _
                  " isnull(B.Description,'') As Package, IsNull(A.VIP,0) As VIP  " & _
                  " from PATIENT_DATA..tbPatient2 A " & _
                  " LEFT OUTER JOIN build_file..tbExecPackageCode B On A.PackageId = B.PackageID " & _
                  " Where A.idnum = '" & myclsbilling.MyclsPatient.IdNum & "'", pclsUser.sqlconnection, adOpenForwardOnly, adLockReadOnly
    
    If Not recOther.EOF Then
        
        strTransplant = IIf(IsNull(recOther!transplantID), "0", recOther!transplantID)
        strDialysis = IIf(IsNull(recOther!dialysisID), "0", recOther!dialysisID)
        
        If Not Trim$(recOther!Package) = "" Then
            .Caption = " Executive Package Type : " & Trim$(recOther!Package)
        End If

        .Caption = IIf(recOther!VIP = True, Trim$(.Caption) & Space(10) & "( Patient is Tag As VIP PATIENT )", .Caption)

        'Check if Senior Citizen
        If myclsbilling.Check_Patient_IsSeniorCitizen(myclsbilling.MyclsPatient.IdNum) Then
            .Caption = Trim$(.Caption) & " ( Patient is Senior Citizen )"
        End If
        
        Dim PackageType As String
        PackageType = Trim$(myclsbilling.Get_Patient_PackageType(myclsbilling.MyclsPatient.IdNum, IIf(Right$(Trim$(myclsbilling.MyclsPatient.IdNum), 1) = "B", "O", "I")))
        If PackageType <> "" Then
            .Caption = Trim$(.Caption) & "Executive Package Type : " + PackageType
        End If
        

        Select Case Trim$(strTransplant)
        Case "0"
            strTransplantDescription = "Non_Transplant"
        Case "1"
            strTransplantDescription = "Transplant"
        End Select

        Select Case Trim$(strDialysis)
        Case "0"
            strDialysisDescription = "None"
        Case "1"
            strDialysisDescription = "Pre-Dialysis"
        Case "2"
            strDialysisDescription = "Post-Dialysis"
        End Select
    End If
    recOther.Close
    Set recOther = Nothing

    End With

End Function


'Public Function Get_Patient_OtherInfo()
'Dim recOther As New ADODB.Recordset
'
'recOther.Open "select * from PATIENT_DATA..tbPatient2 where idnum = '" & myclsbilling.MyclsPatient.idnum & "'", pclsUser.sqlconnection, adOpenForwardOnly, adLockReadOnly
'If Not recOther.EOF Then
' strTransplant = IIf(IsNull(recOther!transplantID), "0", recOther!transplantID)
' strDialysis = IIf(IsNull(recOther!dialysisID), "0", recOther!dialysisID)
'
' Select Case Trim$(strTransplant)
'  Case "0"
'   strTransplantDescription = "Non_Transplant"
'  Case "1"
'   strTransplantDescription = "Transplant"
' End Select
' Select Case Trim$(strDialysis)
'  Case "0"
'   strDialysisDescription = "None"
'  Case "1"
'   strDialysisDescription = "Pre-Dialysis"
'  Case "2"
'   strDialysisDescription = "Post-Dialysis"
' End Select
'End If
'recOther.Close
'Set recOther = Nothing
'End Function