Public Function LoadWorkFlowMain(dDate As Date, strPeriod As String)
'====Loads form!WorkFlowMain
On Error GoTo LoadWorkFlowMainErr
Dim msql As String, msqlA As String, rs As DAO.Recordset, rsC As DAO.Recordset
Dim strBMon As String, strBDay As String, strBYr As String
Dim frmwf As Form, strPDFolder As String, strPID As String, strRecNum As String
Dim startDate As Date, endDate As Date
DoCmd.Hourglass True
strBMon = Format(dDate, "mm")
strBDay = Format(dDate, "dd")
strBYr = Format(dDate, "yyyy")
If DoesTableExist("tempWorkFlow") = True Then
DoCmd.DeleteObject acTable, "tempWorkFlow"
End If
Select Case strPeriod
Case "d"
msql = "SELECT ledger.[Month] & Chr(47) & ledger.[Day] & Chr(47) & ledger.[Year] AS DOS, Trim(ledger.patientid) AS PID, " & _
"Trim(Patient.Lastname) & Chr(44) & Chr(32) & Trim(patient.firstname) AS PName, " & _
" Right(Trim(ledger.description),6) AS SpecNum, ledger.code, ledger.AcctID " & _
" INTO tempWorkFlow " & _
"FROM ledger LEFT JOIN Patient ON ledger.patientID = Patient.ID " & _
"WHERE (((ledger.[Year]) = '" & strBYr & "') AND ((ledger.[Month]) = '" & strBMon & "') AND ((ledger.[Day]) = '" & strBDay & "')) AND ((ledger.code) = 'SP')"
Case "w"
startDate = dDate - Weekday(dDate) + 1
endDate = dDate - Weekday(dDate) + 7
If DoesTableExist("tempLedger") = True Then
DoCmd.DeleteObject acTable, "tempLedger"
End If
msql = "SELECT PatientID, AcctID, month, day, year, code, description, DateSerial(year, month, day) AS DOS INTO tempLedger FROM ledger"
CurrentDb.Execute msql
'DoCmd.OpenTable ("tempLedger")
msql = "SELECT tempLedger.*, Trim(tempLedger.patientID) AS PID, trim(patient.lastname)&Chr(44) & Chr(32) & Trim(patient.firstname) AS PName, Right(Trim(templedger.description),6) AS SpecNum INTO tempWorkFlow " & _
"FROM tempLedger Left JOIN Patient ON templedger.patientID = Patient.ID " & _
"WHERE (DOS BETWEEN #" & startDate & "# AND #" & endDate & "#) AND Code = 'SP' ORDER BY DOS"
Case "m"
msql = "SELECT ledger.[Month] & Chr(47) & ledger.[Day] & Chr(47) & ledger.[Year] AS DOS, Trim(ledger.patientid) AS PID, " & _
"Trim(Patient.Lastname) & Chr(44) & Chr(32) & Trim(patient.firstname) AS PName, " & _
" Right(Trim(ledger.description),6) AS SpecNum, ledger.code, ledger.AcctID " & _
" INTO tempWorkFlow " & _
"FROM ledger LEFT JOIN Patient ON ledger.patientID = Patient.ID " & _
"WHERE (((ledger.[Year]) = '" & strBYr & "') AND ((ledger.[Month]) = '" & strBMon & "') ) AND ((ledger.code) = 'SP') ORDER BY ledger.[Day]"
End Select
CurrentDb.Execute msql
CurrentDb.Execute "ALTER TABLE tempWorkFlow ADD COLUMN WDAcctBal Text(20)"
CurrentDb.Execute "ALTER TABLE tempWorkFlow ADD COLUMN AcctBal Text(20)"
CurrentDb.Execute "ALTER TABLE tempWorkFlow ADD COLUMN Charged Text(20)"
CurrentDb.Execute "ALTER TABLE tempWorkFlow ADD COLUMN PDocs Text(20)"
CurrentDb.Execute "ALTER TABLE tempWorkFlow ADD COLUMN ID COUNTER"
Set rs = CurrentDb.OpenRecordset("tempWorkFlow")
Do Until rs.EOF
strPID = rs!PID
rs.Edit
'Windent AcctBal
rs!WDAcctBal = DLookup("acctbal", "Account", "accountID = '" & rs!AcctID & "'")
'PatientDocs AcctBal
Set rsC = CurrentDb.OpenRecordset("SELECT * FROM tblBillings WHERE AID = '" & rs!AcctID & "'")
If rsC.RecordCount = 0 Then
rs!AcctBal = "No Bill"
Else
Do Until rsC.EOF
If IsNull(rs!AcctBal) Then rs!AcctBal = CLng(0)
rs!AcctBal = CDbl(rs!AcctBal) + CDbl(rsC!BillBalance)
rsC.MoveNext
Loop
End If
rsC.Close
'WD Charges
If DoesTableExist("tempWorkFlowCharges") = True Then
DoCmd.DeleteObject acTable, "tempWorkFlowCharges"
End If
CurrentDb.Execute ("SELECT ledger.code, ledger.patientid INTO tempWorkFlowCharges FROM ledger WHERE PatientID = '" & rs!PID & "' AND Code <> 'SP'")
Set rsC = CurrentDb.OpenRecordset("tempWorkFlowCharges")
rsC.MoveLast
strRecNum = rsC.RecordCount
rsC.MoveFirst
If strRecNum < 1 Then
rs!Charged = "XXX"
Else
Do Until rsC.EOF
If Trim(rsC!Code) = "REFFROM" Then
rs!Charged = "XXX"
GoTo skip
Else
rs!Charged = "Posted"
GoTo skip1
End If
skip:
rsC.MoveNext
Loop
skip1:
End If
rsC.Close
'PatientDocs Files
strPDFolder = DLookup("PatientDocs", "LinkPaths") & strPID & "\"
If DoesFolderExist(strPDFolder) = True Then
rs!PDocs = "Good"
Else
rs!PDocs = "Missing"
End If
rs.Update
'===Progress Bar
Select Case Forms!PopupBuilding!lblBuilding.Caption
Case "Building Please Wait..."
Forms!PopupBuilding!lblBuilding.Caption = "Building Please Wait... ."
Case "Building Please Wait... ."
Forms!PopupBuilding!lblBuilding.Caption = "Building Please Wait... . ."
Case "Building Please Wait... . ."
Forms!PopupBuilding!lblBuilding.Caption = "Building Please Wait... . . ."
Case "Building Please Wait... . . ."
Forms!PopupBuilding!lblBuilding.Caption = "Building Please Wait... . . . ."
Case "Building Please Wait... . . . ."
Forms!PopupBuilding!lblBuilding.Caption = "Building Please Wait... . . . . ."
Case "Building Please Wait... . . . . ."
Forms!PopupBuilding!lblBuilding.Caption = "Building Please Wait... . . . . . ."
Case "Building Please Wait... . . . . . ."
Forms!PopupBuilding!lblBuilding.Caption = "Building Please Wait... . . . . . . ."
Case "Building Please Wait... . . . . . . ."
Forms!PopupBuilding!lblBuilding.Caption = "Building Please Wait... . . . . . . . ."
Case "Building Please Wait... . . . . . . . ."
Forms!PopupBuilding!lblBuilding.Caption = "Building Please Wait... . . . . . . . . ."
Case "Building Please Wait... . . . . . . . . ."
Forms!PopupBuilding!lblBuilding.Caption = "Building Please Wait... . . . . . . . . . ."
Case "Building Please Wait... . . . . . . . . . ."
Forms!PopupBuilding!lblBuilding.Caption = "Building Please Wait..."
End Select
DoEvents
rs.MoveNext
Loop
rs.Close
LoadWorkFlowMainExit:
DoCmd.Hourglass False
Set frmwf = Nothing
Set rs = Nothing
Set rsC = Nothing
msql = ""
Exit Function
LoadWorkFlowMainErr:
MsgBox "PatientDocsPulbic-LoadWorkFlowMain: " & Err.Number & " - " & Err.Description
Resume LoadWorkFlowMainExit
End Function