• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• Billing Schedule with Grid

Billing Schedule with Grid

Billing Schedule with Grid

API Declarations


''' email : [email protected] & _
''' Date : 12-24-2002 Tuesday & _

Implemented Professional Billing Cycle Coding based on Day by Day Payment Schedule to the Client I have used Third Party Active X Control Protoview DataTable 5.0 Smart Grid Control to maintain billing. In addition, Billing is depend on the first Date that Client came in to the Clinic/Hospital and that would be updating by reverse Order. Here i also created Fill Procedures to select files in a Combo by Grid. The Billing Cycle is based on BillCheck Procedure so have a look and if you have any question regarding this coding
then you can reach me at [email protected].

Dim RsFillClient As New ADODB.Recordset
Dim RsFillMedicAidNo As New ADODB.Recordset
Dim RsFillClientLastName As New ADODB.Recordset
Dim RsGetLastRateCode As New ADODB.Recordset
Dim SetVariable As String
Dim StoredValue As String
Dim LastDate As Date
Dim KeyTracking As String
Private ColumnNumber As Variant
Dim PreviousGridCounter As Integer
Dim CurrentGridCounter As Integer
Dim PreviousValue As String
Dim PreviousValue1 As String
Dim RsDummyForInvoiceGrid As New ADODB.Recordset
Private ColumnNumbers As Integer
Dim RsUpdateBilling As New ADODB.Recordset
Dim RsTempExceptionCalender As New ADODB.Recordset



Rate Billing Schedule with Grid

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = 112 Then
    Dim RsGetDateCount As New ADODB.Recordset
            
        If RsGetDateCount.State = 1 Then
            RsGetDateCount.Close
        End If
            
        RsGetDateCount.CursorLocation = adUseClient
        RsGetDateCount.Open "Select BillDate from Client where Client_IDSS=" & cboClientID, SDS_Cnn, adOpenKeyset, adLockReadOnly
        
        GetBillDate = RsGetDateCount!BillDate
        
        If RsProgramStatndard.State = 1 Then
            RsProgramStatndard.Close
        End If
        RsProgramStatndard.CursorLocation = adUseClient
        RsProgramStatndard.Open "Select Distinct Top 1 BillingDate, BillingStatusFlag From ClaimInvoiceDetail Where Client_IDSS = '" & cboClientID.Text & "' Order By BillingDate Desc", SDS_Cnn, adOpenForwardOnly, adLockReadOnly
        
        If Not RsProgramStatndard.EOF Then
        
        If Format(RsProgramStatndard!BillingDate, "mm/dd/yyyy") = Format(Date, "mm/dd/yyyy") And RsProgramStatndard!BillingStatusFlag = "Pending" Then
            MsgBox "This Client has been already billed", vbCritical, "Survey Data Systems"
            tblClientCalendarDetail.Rowset.Reset
            tblClaimInvoice.Rowset.Reset
            Exit Sub
        Else
        GetBillDate = CVDate(RsProgramStatndard!BillingDate) + 1
        End If
        
        End If
        
        If RsProgramStatndard.State = 1 Then
            RsProgramStatndard.Close
        End If
        
        RsProgramStatndard.CursorLocation = adUseClient
        RsProgramStatndard.Open
        
        GetDateDifferece = DateDiff("D", Format(GetBillDate, "MM/DD/YYYY"), Format(Date, "MM/DD/YYYY"))
                        
        GetDateDifferece = GetDateDifferece + 1
                        
        LastDate = Format(GetBillDate, "MM/DD/YYYY")
        tblClientCalendarDetail.Rowset.Reset
        
        For iCounter = tblClientCalendarDetail.Rowset.Count To GetDateDifferece - 1
            tblClientCalendarDetail.Rowset.Add dtAfterLast
            tblClientCalendarDetail.CellSet(iCounter, 0).Value = Format(LastDate, "mm/dd/yyyy")
                GetDate = CVDate(Format(LastDate, "MM/DD/YYYY")) + 1
                LastDate = GetDate
                                
                    If LastDate > Date Then
                        tblClientCalendarDetail.ColumnSet(0).DataEdit = editProtected
                        Call FillPatientStatusINGrid
                        Call FillGridRateCode
                        Call FillAttandanceStatusINGrid
                        SQL = "Delete From DummyTable"
                        SDS_Cnn.Execute SQL
                        SQL = ""
                        SQL = "Delete From DummyTable1"
                        SDS_Cnn.Execute SQL
                        
                        
        
                        If RsTempExceptionCalender.State = 1 Then
                            RsTempExceptionCalender.Close
                        End If
                        
                        RsTempExceptionCalender.CursorLocation = adUseClient
                        RsTempExceptionCalender.Open "Delete From DummyTable1", SDS_Cnn, adOpenDynamic, adLockOptimistic
                        
                        If RsTempExceptionCalender.State = 1 Then
                            RsTempExceptionCalender.Close
                        End If
                        
                        RsTempExceptionCalender.Open "Select * From DummyTable1", SDS_Cnn, adOpenDynamic, adLockOptimistic
                        
                        For jCounter = RsTempExceptionCalender.RecordCount To tblClientCalendarDetail.Rowset.Count - 1
                            RsTempExceptionCalender.AddNew
                            RsTempExceptionCalender.Fields(0).Value = Format(tblClientCalendarDetail.CellSet(jCounter, 0).Value, "MM/DD/YYYY")
                            RsTempExceptionCalender.Fields(1).Value = tblClientCalendarDetail.CellSet(jCounter, 1).Value
                            RsTempExceptionCalender.Fields(2).Value = tblClientCalendarDetail.CellSet(jCounter, 2).Value
                            RsTempExceptionCalender.Fields(3).Value = tblClientCalendarDetail.CellSet(jCounter, 3).Value
                            RsTempExceptionCalender.Update
                        Next jCounter
                        
                        Exit Sub
                    End If
                           
        Next iCounter
        Exit Sub
    End If
    

If KeyCode = 113 Then
    
    If tblClientCalendarDetail.Rowset.Count = 0 Then
        MsgBox "You Must have to select Billing First", vbInformation, "Survey Data Systems"
        Exit Sub
    End If
    
    
    
    If RsTempExceptionCalender.State = 1 Then
        RsTempExceptionCalender.Close
    End If
                        
    RsTempExceptionCalender.CursorLocation = adUseClient
    RsTempExceptionCalender.Open "Delete From DummyTable1", SDS_Cnn, adOpenDynamic, adLockOptimistic
    SQL = "Delete From DummyTable"
    SDS_Cnn.Execute SQL
    
    If RsTempExceptionCalender.State = 1 Then
        RsTempExceptionCalender.Close
    End If
                        
    RsTempExceptionCalender.Open "Select * From DummyTable1", SDS_Cnn, adOpenDynamic, adLockOptimistic
                        
    For jCounter = RsTempExceptionCalender.RecordCount To tblClientCalendarDetail.Rowset.Count - 1
        RsTempExceptionCalender.AddNew
            RsTempExceptionCalender.Fields(0).Value = Format(tblClientCalendarDetail.CellSet(jCounter, 0).Value, "MM/DD/YYYY")
            RsTempExceptionCalender.Fields(1).Value = tblClientCalendarDetail.CellSet(jCounter, 1).Value
            RsTempExceptionCalender.Fields(2).Value = tblClientCalendarDetail.CellSet(jCounter, 2).Value
            RsTempExceptionCalender.Fields(3).Value = tblClientCalendarDetail.CellSet(jCounter, 3).Value
        RsTempExceptionCalender.Update
    Next jCounter


    If KeyTracking = "" Then
        ColumnNumbers = 2
    End If
    
    BillChecker "", ColumnNumbers, GloballyStatusChecker
    
End If

If KeyCode = 114 Then


    
    If tblClaimInvoice.Rowset.Count = 0 Then
        MsgBox "You can't Proceed Billing before Press F-2", vbInformation, "Survey Data Systems"
        Exit Sub
    End If
    
    If RsProgramStatndard.State = 1 Then
        RsProgramStatndard.Close
    End If
    
    RsProgramStatndard.CursorLocation = adUseClient
    RsProgramStatndard.Open "Select Max(ClaimInvoice_NO) As ClaimInvoiceNumber From ClaimInvoice", SDS_Cnn, adOpenDynamic, adLockOptimistic
    
    SDS_Cnn.BeginTrans
    
    If IsNull(RsProgramStatndard!ClaimInvoiceNumber) Then
        ProgramVariable = 1
    Else
        ProgramVariable = (RsProgramStatndard!ClaimInvoiceNumber) + 1
    End If
        
    If RsProgramStatndard.State = 1 Then
        RsProgramStatndard.Close
    End If
    
    RsProgramStatndard.CursorLocation = adUseClient
    RsProgramStatndard.Open "Select * From ClaimInvoice", SDS_Cnn, adOpenDynamic, adLockOptimistic
        
    RsProgramStatndard.AddNew
    RsProgramStatndard!ClaimInvoice_NO = Val(ProgramVariable)
    RsProgramStatndard!ClaimInvoiceDate = Format(Date, "mm/dd/yyyy")
    RsProgramStatndard.Update
    Dim RsClaimInvoice As New ADODB.Recordset
    If RsClaimInvoice.State = 1 Then
        RsClaimInvoice.Close
    End If
    
    RsClaimInvoice.CursorLocation = adUseClient
    RsClaimInvoice.Open "Select * From ClaimInvoiceDetail", SDS_Cnn, adOpenDynamic, adLockOptimistic
    
    For iCounter = 0 To tblClaimInvoice.Rowset.Count - 1
        RsClaimInvoice.AddNew
        RsClaimInvoice!ClaimInvoiceDescription_ID = tblClaimInvoice.CellSet(iCounter, 0).Value
        
        If GloballyStatusChecker.State = 1 Then
            GloballyStatusChecker.Close
        End If
        GloballyStatusChecker.CursorLocation = adUseClient
        GloballyStatusChecker.Open "Select Distinct Top 1 RateCodeInformation.RateCodeinfo_ID, RateCodeInformation.EffectiveDate From Provider, RateCodeInformation Where RateCodeInformation.Provider_Id = Provider.Provider_ID And Provider.Provider_Id = RateCodeInformation.Provider_ID And Provider.Provider_ID = '" & txtProviderID & "' Order by RateCodeInformation.EffectiveDate Desc", SDS_Cnn, adOpenKeyset, adLockReadOnly
        
        RsClaimInvoice!RateCodeInfo_ID = GloballyStatusChecker!RateCodeInfo_ID
        RsClaimInvoice!ClaimInvoice_NO = ProgramVariable
        RsClaimInvoice!FromDate = Format(tblClaimInvoice.CellSet(iCounter, 1).Value, "mm/dd/yyyy")
        RsClaimInvoice!TODate = Format(tblClaimInvoice.CellSet(iCounter, 2).Value, "mm/dd/yyyy")
        
        If GloballyStatusChecker.State = 1 Then
            GloballyStatusChecker.Close
        End If
        GloballyStatusChecker.CursorLocation = adUseClient
        GloballyStatusChecker.Open "Select * From Attandance Where Attandance_Description = '" & tblClaimInvoice.CellSet(iCounter, 4).Value & "'", SDS_Cnn, adOpenKeyset, adLockReadOnly
        RsClaimInvoice!Attandance_ID = GloballyStatusChecker!Attandance_ID
        
        
        If GloballyStatusChecker.State = 1 Then
            GloballyStatusChecker.Close
        End If
        GloballyStatusChecker.CursorLocation = adUseClient
        GloballyStatusChecker.Open "Select * From PatientStatus Where PatientStatus_Description = '" & tblClaimInvoice.CellSet(iCounter, 5).Value & "'", SDS_Cnn, adOpenKeyset, adLockReadOnly
        RsClaimInvoice!PatientStatus_ID = GloballyStatusChecker!PatientStatus_ID
        
        RsClaimInvoice!Client_IDSS = cboClientID.Text
        RsClaimInvoice!NumberOFDays = tblClaimInvoice.CellSet(iCounter, 6).Value
        RsClaimInvoice!UnitOFDays = tblClaimInvoice.CellSet(iCounter, 7).Value
        RsClaimInvoice!BillingDate = Format(Date, "mm/dd/yyyy")
        RsClaimInvoice!BillingAmount = tblClaimInvoice.CellSet(iCounter, 8).Value
        RsClaimInvoice!BillingStatusFlag = "Pending"
        RsClaimInvoice.Update
    Next iCounter
SQL = "Update Client Set BillDate = '" & Format(Date, "mm/dd/yyyy") & "' Where Client_IDSS ='" & cboClientID.Text & "'"
SDS_Cnn.Execute SQL
SDS_Cnn.CommitTrans
frmStatusDescriber.Show
End If
End Sub


''' Private Procedure For Billing Schedule written by ShahRukh, 12-15-2002 Sunday.
Private Sub BillChecker(ByRef PreviousValue As String, ByRef GridColumnNumber As Integer, ByVal RsUpdateBillingSchedule As ADODB.Recordset)
PreviousValue = ""
Static PreviousDate As String

If RsUpdateBillingSchedule.State = 1 Then
    RsUpdateBillingSchedule.Close
End If

RsUpdateBillingSchedule.Open "Select * From DummyTable1", SDS_Cnn, adOpenDynamic, adLockOptimistic

Dim SaveGridInTable As New ADODB.Recordset

If SaveGridInTable.State = 1 Then
    SaveGridInTable.Close
End If
SaveGridInTable.Open "Select * From DummyTable", SDS_Cnn, adOpenDynamic, adLockOptimistic

Do While Not RsUpdateBillingSchedule.EOF

    If SaveGridInTable.RecordCount = 0 Then
        s = 1
        SaveGridInTable.AddNew
        SaveGridInTable.Fields(0).Value = RsUpdateBillingSchedule.Fields(0).Value
    End If
    
    If (TempDate <> SaveGridInTable.Fields(0).Value) Or _
        (TempAttandanceStatus <> RsUpdateBillingSchedule.Fields(2).Value) Or _
        (TempPatientStatus <> RsUpdateBillingSchedule.Fields(3).Value) Then
        
        If SaveGridInTable.RecordCount = 1 Then
            SaveGridInTable.CancelBatch
        End If
        
        SaveGridInTable.AddNew
        SaveGridInTable.Fields(0).Value = RsUpdateBillingSchedule.Fields(0).Value
    End If
   
    SaveGridInTable.MoveLast
    TempDate = SaveGridInTable.Fields(0).Value
    TempAttandanceStatus = RsUpdateBillingSchedule.Fields(2).Value
    TempPatientStatus = RsUpdateBillingSchedule.Fields(3).Value
    SaveGridInTable.Fields(1).Value = RsUpdateBillingSchedule.Fields(0).Value
    SaveGridInTable.Fields(2).Value = RsUpdateBillingSchedule.Fields(1).Value
    SaveGridInTable.Fields(3).Value = RsUpdateBillingSchedule.Fields(2).Value
    SaveGridInTable.Fields(4).Value = RsUpdateBillingSchedule.Fields(3).Value
    SaveGridInTable.Update

RsUpdateBillingSchedule.MoveNext

Loop
SQL = "Delete From DummyTable Where Date2 = Null"
SDS_Cnn.Execute SQL

Dim checkerReccount As New ADODB.Recordset

If checkerReccount.State = 1 Then
    checkerReccount.CursorLocation = adUseClient
End If

If RsDummyForInvoiceGrid.State = 1 Then
    RsDummyForInvoiceGrid.Close
End If

    tblClaimInvoice.Rowset.Reset
    RsDummyForInvoiceGrid.Open "Select * From DummyTable", SDS_Cnn, adOpenKeyset, adLockReadOnly
GenerateAutoNumber = 1

For CurrentGridCounter = 0 To RsDummyForInvoiceGrid.RecordCount - 1
        tblClaimInvoice.Rowset.Add dtAfterLast
        
        tblClaimInvoice.CellSet(CurrentGridCounter, 0).Value = GenerateAutoNumber
        
        tblClaimInvoice.CellSet(CurrentGridCounter, 1).Value = RsDummyForInvoiceGrid.Fields(0).Value
        tblClaimInvoice.CellSet(CurrentGridCounter, 2).Value = RsDummyForInvoiceGrid.Fields(1).Value

        GetDateDifference = DateDiff("D", Format(tblClaimInvoice.CellSet(CurrentGridCounter, 1).Value & "", "MM/DD/YYYY"), Format(tblClaimInvoice.CellSet(CurrentGridCounter, 2).Value & "", "MM/DD/YYYY")) + 1
        tblClaimInvoice.CellSet(CurrentGridCounter, 6).Value = GetDateDifference

        tblClaimInvoice.CellSet(CurrentGridCounter, 3).Value = RsDummyForInvoiceGrid.Fields(2).Value
        tblClaimInvoice.CellSet(CurrentGridCounter, 4).Value = RsDummyForInvoiceGrid.Fields(3).Value
        tblClaimInvoice.CellSet(CurrentGridCounter, 5).Value = RsDummyForInvoiceGrid.Fields(4).Value
        
        Dim RsGetLatestRateCode As New ADODB.Recordset
        
        If RsGetLatestRateCode.State = 1 Then
            RsGetLatestRateCode.Close
        End If
        
        RsGetLatestRateCode.CursorLocation = adUseClient
        
        'RsGetLatestRateCode.Open "Select RateCodeInformation.Amount, RateCodeInformation.RateCodeInfo_ID From RateCodeInformation, RateCodes Where RateCodes.RateCode_ID =" & _
        '                         "RateCodeInformation.RateCode_ID And RateCodeInformation.RateCode_ID=" & tblClaimInvoice.CellSet(CurrentGridCounter, 3).Value & "Order by EffectiveDate Desc", SDS_Cnn, adOpenKeyset, adLockReadOnly

        'RsGetLatestRateCode.Open "Select RateCodeInformation.Amount, RateCodeInformation.RateCodeInfo_ID From RateCodeInformation, RateCodes Where RateCodes.RateCode_ID =" & _
        '                         "RateCodeInformation.RateCode_ID And RateCodeInformation.RateCode_ID=" & tblClaimInvoice.CellSet(CurrentGridCounter, 3).Value & "Order by EffectiveDate Desc", SDS_Cnn, adOpenKeyset, adLockReadOnly

        RsGetLatestRateCode.Open "Select RateCodeInformation.RateCodeInfo_ID, RateCodeInformation.Provider_ID, RateCodeInformation.RateCode_ID , RateCodeInformation.Amount From RateCodes, Provider, RateCodeInformation Where RateCodes.RateCode_Id = RateCodeInformation.RateCode_ID And  RateCodeInformation.Provider_ID = Provider.Provider_ID and RateCodeInformation.Provider_ID = '" & txtProviderID & "' Order By EffectiveDate Desc", SDS_Cnn, adOpenKeyset, adLockReadOnly

            If tblClaimInvoice.CellSet(CurrentGridCounter, 4).Value = "Half Day" Then
               tblClaimInvoice.CellSet(CurrentGridCounter, 7).Value = RsGetLatestRateCode!Amount / 2
               tblClaimInvoice.CellSet(CurrentGridCounter, 8).Value = tblClaimInvoice.CellSet(CurrentGridCounter, 6).Value * tblClaimInvoice.CellSet(CurrentGridCounter, 7).Value
            ElseIf tblClaimInvoice.CellSet(CurrentGridCounter, 4).Value = "Absent" Then
                tblClaimInvoice.CellSet(CurrentGridCounter, 7).Value = 0
               tblClaimInvoice.CellSet(CurrentGridCounter, 8).Value = 0
            Else
               tblClaimInvoice.CellSet(CurrentGridCounter, 7).Value = RsGetLatestRateCode!Amount
               tblClaimInvoice.CellSet(CurrentGridCounter, 8).Value = tblClaimInvoice.CellSet(CurrentGridCounter, 6).Value * tblClaimInvoice.CellSet(CurrentGridCounter, 7).Value
            End If
    GenerateAutoNumber = GenerateAutoNumber + 1
    RsDummyForInvoiceGrid.MoveNext

Next CurrentGridCounter
End Sub
''''''''''''''''''''' End Patch by ShahRukh Muhammad


Private Sub FillGridRateCode()
Dim RsRateCodeForGrid As New ADODB.Recordset
RsRateCodeForGrid.CursorLocation = adUseClient
RsRateCodeForGrid.Open "Select * from RateCodes", SDS_Cnn, adOpenKeyset, adLockReadOnly

    Do Until RsRateCodeForGrid.EOF
        GetRateCodeInformation = RsRateCodeForGrid!RateCode_ID
            RsRateCodeForGrid.MoveNext
    Loop
    
    For i = 0 To tblClientCalendarDetail.Rowset.Count - 1
        tblClientCalendarDetail.CellSet(i, 1).Value = GetRateCodeInformation
    Next i

    tblClientCalendarDetail.ColumnSet(1).DataEdit = editProtected
    
End Sub

Private Sub FillPatientStatusINGrid()

Dim FillPatientINGrid As New ADODB.Recordset
FillPatientINGrid.CursorLocation = adUseClient
FillPatientINGrid.Open "Select * from PatientStatus", SDS_Cnn, adOpenKeyset, adLockReadOnly

    Do Until FillPatientINGrid.EOF
        GetPatientStatus = GetPatientStatus + FillPatientINGrid!PatientStatus_Description & Chr(9)
            FillPatientINGrid.MoveNext
    Loop
    tblClientCalendarDetail.ColumnSet(3).List = GetPatientStatus
    
   For i = 0 To tblClientCalendarDetail.Rowset.Count - 1
        tblClientCalendarDetail.CellSet(i, 3).Value = GetPatientStatus
   Next i
    
   For i = 0 To tblClientCalendarDetail.Rowset.Count - 1
       tblClientCalendarDetail.CellSet(i, 3).Value = "Still A Patient"
   Next i
   
   tblClientCalendarDetail.ColumnSet(3).DataEdit = editProtected
  
End Sub


Private Sub FillAttandanceStatusINGrid()
Dim FillAttandanceINGrid As New ADODB.Recordset
FillAttandanceINGrid.CursorLocation = adUseClient
FillAttandanceINGrid.Open "Select * from Attandance", SDS_Cnn, adOpenKeyset, adLockReadOnly

    Do Until FillAttandanceINGrid.EOF
        GetAttandanceStatus = GetAttandanceStatus + FillAttandanceINGrid!Attandance_Description & Chr(9)
        FillAttandanceINGrid.MoveNext
    Loop
    
    tblClientCalendarDetail.ColumnSet(2).List = GetAttandanceStatus
    
    For i = 0 To tblClientCalendarDetail.Rowset.Count - 1
        tblClientCalendarDetail.CellSet(i, 2).Value = GetAttandanceStatus
    Next i
    
    For i = 0 To tblClientCalendarDetail.Rowset.Count - 1
        tblClientCalendarDetail.CellSet(i, 2).Value = "Present"
    Next i
    
    tblClientCalendarDetail.ColumnSet(2).DataEdit = editProtected
    
End Sub