Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.
Option Compare Database
Option Explicit
------------------------------------------------------------------------------------------------------
Private Sub CalcCT_Enter()
Dim db As Dao.Database
Dim rs As Dao.Recordset ' Calculate Exam Totals
Dim rs1 As Dao.Recordset 'Calculate Head and Neck
Dim rs2 As Dao.Recordset 'Calculate Chest
Dim rs3 As Dao.Recordset 'Calculate Spine
Dim rs4 As Dao.Recordset 'Calculate Pelvis
Dim rs5 As Dao.Recordset 'Calculate Extremity
Dim rs6 As Dao.Recordset 'Calculate Abdomen
Dim rs7 As Dao.Recordset 'Calculate Pulmonary
Dim rs8 As Dao.Recordset 'Calculate Guidance
Dim rs9 As Dao.Recordset 'Calculate Rad therapy
Dim rs10 As Dao.Recordset 'Calculate Other procedure
Dim rs11 As Dao.Recordset 'Recontruction
Dim rs12 As Dao.Recordset 'Read only
Dim dblCTTotal As Double ' Total Exams
Dim dblCT1 As Double 'Same as above
Dim dblCT2 As Double ' "
Dim dblCT3 As Double ' "
Dim dblCT4 As Double ' "
Dim dblCT5 As Double ' "
Dim dblCT6 As Double ' "
Dim dblCT7 As Double ' "
Dim dblCT8 As Double ' "
Dim dblCT9 As Double ' "
Dim dblCT10 As Double ' "
Dim dblCT11 As Double ' "
Dim dblCT12 As Double ' "
Set db = CurrentDb
Set rs = db.OpenRecordset("Select [Total Exams] FROM [qrycurrent]")
Do Until rs.EOF
dblCTTotal = rs![Total Exams] + dblCTTotal
rs.MoveNext
Loop
CTTotal = dblCTTotal
Set rs1 = db.OpenRecordset("Select [Total Exams] FROM [qrycurrent] WHERE [CPT_Code] >= 70000 And [CPT_Code] <= 70999")
Do Until rs1.EOF
dblCT1 = rs1![Total Exams] + dblCT1
rs1.MoveNext
Loop
CT1 = dblCT1
Set rs2 = db.OpenRecordset("Select [Total Exams] FROM [qrycurrent] WHERE [CPT_Code] >= 71000 And [CPT_Code] <= 71999")
Do Until rs2.EOF
dblCT2 = rs2![Total Exams] + dblCT2
rs2.MoveNext
Loop
CT2 = dblCT2
Set rs3 = db.OpenRecordset("Select [Total Exams] FROM [qrycurrent] WHERE [CPT_Code] >= 72125 And [CPT_Code] <= 72132")
Do Until rs3.EOF
dblCT3 = rs3![Total Exams] + dblCT3
rs3.MoveNext
Loop
CT3 = dblCT3
Set rs4 = db.OpenRecordset("Select [Total Exams] FROM [qrycurrent] WHERE [CPT_Code] = 72192 Or [CPT_Code] =72193")
Do Until rs4.EOF
dblCT4 = rs4![Total Exams] + dblCT4
rs4.MoveNext
Loop
CT4 = dblCT4
Set rs5 = db.OpenRecordset("Select [Total Exams] FROM [qrycurrent] WHERE ([CPT_Code] >= 73200 And [CPT_Code] <= 73202) Or ([CPT_Code] >= 73700 And [CPT_Code] <= 73702)")
Do Until rs5.EOF
dblCT5 = rs5![Total Exams] + dblCT5
rs5.MoveNext
Loop
CT5 = dblCT5
Set rs6 = db.OpenRecordset("Select [Total Exams] FROM [qrycurrent] WHERE [CPT_Code] >= 74150 And [CPT_Code] <=74170")
Do Until rs6.EOF
dblCT6 = rs6![Total Exams] + dblCT6
rs6.MoveNext
Loop
CT6 = dblCT6
Set rs7 = db.OpenRecordset("Select [Total Exams] FROM [qrycurrent] WHERE [CPT_Code] = 75746")
Do Until rs7.EOF
dblCT7 = rs7![Total Exams] + dblCT7
rs7.MoveNext
Loop
CT7 = dblCT7
Set rs8 = db.OpenRecordset("Select [Total Exams] FROM [qrycurrent] WHERE [CPT_Code] = 76360 Or [CPT_Code] =75989 Or [CPT_Code] =76365")
Do Until rs8.EOF
dblCT8 = rs8![Total Exams] + dblCT8
rs8.MoveNext
Loop
CT8 = dblCT8
Set rs9 = db.OpenRecordset("Select [Total Exams] FROM [qrycurrent] WHERE [CPT_Code] = 76370")
Do Until rs9.EOF
dblCT9 = rs9![Total Exams] + dblCT9
rs9.MoveNext
Loop
CT9 = dblCT9
Set rs10 = db.OpenRecordset("Select [Total Exams] FROM [qrycurrent] WHERE [CPT_Code] = 76380")
Do Until rs10.EOF
dblCT10 = rs10![Total Exams] + dblCT10
rs10.MoveNext
Loop
CT10 = dblCT10
Set rs11 = db.OpenRecordset("Select [Total Exams] FROM [qrycurrent] WHERE [CPT_Code] = 76375")
Do Until rs11.EOF
dblCT11 = rs11![Total Exams] + dblCT11
rs11.MoveNext
Loop
CT11 = dblCT11
Set rs12 = db.OpenRecordset("Select [Total Exams] FROM [qrycurrent] WHERE [CPT_Code] = 76140")
Do Until rs12.EOF
dblCT12 = rs12![Total Exams] + dblCT12
rs12.MoveNext
Loop
CT12 = dblCT12
End Sub
------------------------------------------------------------------------------------------------------
Private Sub Form_Open(Cancel As Integer)
CalcCT_Enter
End Sub
Frm-Design-Mode.jpgPrivate Sub Command0_Click()
Dim i As Integer
Dim val As Integer
Dim fld As String
Dim sqlSTr As String
For i = 1 To 10
' make up a number for the ct value'
val = CInt(Rnd() * 100)
'get field name from i '
fld = "ct" & CStr(i)
sqlSTr = "update CtTable2 set CtTable2.[value] = " & val & " where (((CtTable2.xtype) = " & Left("""", 1) & "CT" & Left("""", 1) & ") AND ((CtTable2.fld) = " & Left("""", 1) & fld & Left("""", 1) & "));"
'MsgBox sqlSTr '
DoCmd.SetWarnings False
DoCmd.RunSQL sqlSTr
DoCmd.SetWarnings True
Next i
End Sub
pie.mdb
in your vba code, add a docmd.runsql("update mytable set myfield=myvalue where id = 1")...
this wouldpopulate your table data aset
( you could even get cheeky and use a 2nd function which accepts field and value and adds those in to the sql)
then write yourself a report which draws a pie chart based on the data in the table...