by ShahRukh Muhammad (1 Submission)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 31st December 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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
VBcoders
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
