1 Create a dMeasure object

library(dMeasure)
packageVersion("dMeasure")
#> [1] '0.9.6'

# creates a dMeasure object named 'a'. Could be named something else.
a <- dMeasure::dMeasure$new()

2 Configuration file

a$configuration_file_path
#> [1] "~/.DailyMeasure_cfg.sqlite"

a$configuration_file_path <- "~/.MySpecialConfig.sqlite"
a$configuration_file_path
#> [1] "~/.MySpecialConfig.sqlite"

a$open_configuration_db()
a$read_configuration_db()

3 Best Practice Database Server configuration

Add a server definition, and show server definitions.

a$server.insert(list(Name = "MyServer", Address = "127.0.0.1\\BPSINSTANCE",
                     Database = "BPSSAMPLES", UserID = "bpsrawdata",
                     dbPassword = "mypassword"))

a$server.list()

A description of many methods can be shown using the package’s help documentation, as shown for server.insert below. Note that the function server.insert includes an initial argument dMeasure_obj which is not used in the method server.insert.

?dMeasure::server.insert

server.insert(dMeasure_obj, description)

a <- dMeasure::dMeasure$new()
a$open_configuration_db()
a$read_configuration_db()
a$server.insert(list(Name = "MyServer", Address = "127.0.0.1\\BPSINSTANCE",
                     Database = "BPSSAMPLES", UserID = "bpsrawdata",
                     dbPassword = "mypassword"))

id <- a$server.list() %>% dplyr::filter(Name == "MyServer") %>% dplyr::pull(id)
a$server.update(list(id = id, Database = "BPSPATIENTS"))

id <- a$server.list() %>% dplyr::filter(Name == "MyServer") %>% dplyr::pull(id)
if (length(id) == 1) {
  a$server.delete(list(id = id))
}

a$BPdatabaseChoice <- "None" # set to null choice

a$BPdatabaseChoice # returns the current database description choice
#> [1] "None"

a$BPdatabaseChoice <- "Main" # this will also open the 'Main' database description, if possible
#> [1] "Opening EMR database"
#> [1] "Re-initializing databases"
#> [1] "dbversion: 1"

a$close() # closes the database connections

4 Opening the Best Practice database connection

a <- dMeasure::dMeasure$new()
a$open_emr_db() # this will try to open the most recent database description choice, in this case, 'Main'
#> [1] "ChosenServerName: Main"
#> [1] "Opening EMR database"
#> [1] "Re-initializing databases"
#> [1] "dbversion: 1"
#> [1] "Main"

5 User configuration

# a$UserConfig
# shows user configuration as stored in dMeasure's configuration file
DT::datatable(a$UserConfig,
              extension = "Scroller",
              options = list(scroller = TRUE, deferRender = TRUE,
                             scrollX = TRUE, scrollY = 200))

# a$UserConfigLicense
# decodes the 'License'/(subscription) to a 'License (Expiry) Date'
DT::datatable(a$UserConfigLicense,
              extension = "Scroller",
              options = list(scroller = TRUE, deferRender = TRUE,
                             scrollX = TRUE, scrollY = 200))

# a$UserFullConfig
# shows user configuration
# information combined from dMeasure's configuration file and the EMR (Best Practice) database
# includes the 'decoded' license date
DT::datatable(a$UserFullConfig,
              extension = "Scroller",
              options = list(scroller = TRUE, deferRender = TRUE,
                             scrollX = TRUE, scrollY = 200))

A ‘manual entry’ of subscription/license information can be done…

DrIvorCureIdentifier <- 
  a$UserFullConfig %>% dplyr::collect() %>%
  dplyr::filter(Fullname == "Dr Ivor Cure") %>%
  dplyr::pull(Identifier)

?dMeasure::verify_license

verify_license(License, Identifier)

dMeasure::verify_license(DrIvorCureIdentifier, License = "not_a_real_license")
#> [1] NA

?dMeasure::update_subscription

update_subscription(
  dMeasure_obj,
  Fullname = NA,
  License = NA,
  Identifier = NA,
  verify = TRUE
)

a$update_subscription(Identifier = DrIvorCureIdentifier,
                      License = "not_a_real_license", verify = TRUE)
#> [1] FALSE

The correct way to remove a subscription is to set to ‘NA’

a$update_subscription(Identifier = DrIvorCureIdentifier,
                      Fullname = "Dr Ivor Cure",
                      License = NA, verify = FALSE)
#> [1] TRUE

DT::datatable(a$UserConfigLicense,
              extension = "Scroller",
              options = list(scroller = TRUE, deferRender = TRUE,
                             scrollX = TRUE, scrollY = 200))

Subscription information can be read from the GPstat!/DailyMeasure database.

Note that reading the database will send (encrypted) details of the health care providers over the Internet. Those details are the names of the providers, and either the provider number or the name of the clinic.

?dMeasure::read_subscription_db

read_subscription_db(dMeasure_obj, forcecheck = FALSE, users = NULL)

dMeasure_obj$read_subscription_db()

DT::datatable(a$read_subscription_db(forcecheck = TRUE),
              extension = "Scroller",
              options = list(scroller = TRUE, deferRender = TRUE,
                             scrollX = TRUE, scrollY = 200))
#> [1] "Subscription database opened"

6 Appointment list examples

By default, no clinicans are selected, and the date of searches will be the current date (in this case 2020-04-18).

a$choose_clinicians()
#> character(0)
a$choose_date()
#> [[1]]
#> [1] "2020-04-18"
#> 
#> [[2]]
#> [1] "2020-04-18"

The list of available clinicians can be shown…

a$clinician_choice_list
#> [1] "Dr Frederick Findacure"      "Dr Ivor Cure"               
#> [3] "Miss Jenny Reception"        "Ms. Nadine Nurse"           
#> [5] "Ms.  Susan Senior Reception" "Mr. IT Technician"          
#> [7] "Mrs. Psychology Specialist"  "Mrs. Diabetes Educator"

…some clinicians chosen:

a$choose_clinicians(c("Ms Nadine Nurse", "Mrs. Psychology Specialist",
                      "Dr Frederick Findacure", "Dr Ivor Cure"))
#> [1] "Mrs. Psychology Specialist" "Dr Frederick Findacure"    
#> [3] "Dr Ivor Cure"

…and dates chosen:

a$choose_date(date_from = as.Date("2000-01-01"), date_to = as.Date("2020-01-01"))
#> [[1]]
#> [1] "2000-01-01"
#> 
#> [[2]]
#> [1] "2020-01-01"

Just one of date_from or date_to can be defined.

It is also assumed (if the argument are not ‘named’), that the first argument of choose_date will be date_from, and the second argument (if supplied) will be date_to.

Subsequent calls to many methods, such as those named list_* will, by default, assume the chosen clinicians and dates are those defined by the choose_clinicians and choose_date methods above.

a$list_appointments() %>% head() # 'head' just displays the first few appointments

?dMeasureBillings::billed_appointments

billed_appointments(
  dMeasureBillings_obj,
  date_from = NA,
  date_to = NA,
  clinicians = NA,
  status = NA,
  lazy = FALSE
)

billings <- dMeasureBillings::dMeasureBillings$new(a)

billings$billed_appointments() %>% 
  dplyr::mutate(Description = iconv(Description, "latin1", "ASCII", sub = "")) %>%
  # removes an invalid ASCII character from Description
  head()

7 Billings methods

Billings matched up to appointments and visits.

?dMeasureBillings::list_billings

list_billings(
  dMeasureBillings_obj,
  date_from,
  date_to,
  clinicians,
  own_billings,
  lazy,
  screentag,
  screentag_print
)

print(billings$own_billings) # by default is TRUE, and shows only billings attributable to the provider
#> [1] TRUE

a$choose_date(date_from = as.Date("2019-05-01"), date_to = as.Date("2019-05-30")) # restrict date range
#> [[1]]
#> [1] "2019-05-01"
#> 
#> [[2]]
#> [1] "2019-05-30"
a$choose_clinicians(a$clinician_choice_list) # choose all clinicians
#> [1] "Dr Frederick Findacure"      "Dr Ivor Cure"               
#> [3] "Miss Jenny Reception"        "Ms. Nadine Nurse"           
#> [5] "Ms.  Susan Senior Reception" "Mr. IT Technician"          
#> [7] "Mrs. Psychology Specialist"  "Mrs. Diabetes Educator"

billings$list_billings() %>% head() # an aggregated version of $appointments_billings_sameday()

Show ALL billings for the patient on that day, whether or not attributable to the provider.

billings$own_billings <- FALSE
billings$list_billings() %>% head()

a$choose_date(as.Date("2001-01-01"), Sys.Date()) # reset dates
#> [[1]]
#> [1] "2001-01-01"
#> 
#> [[2]]
#> [1] "2020-04-18"

8 Chronic disease management

Chronic disease management methods are contained within the dMeasureCDM module https://github.com/DavidPatShuiFong/dMeasureCDM.

cdm <- dMeasureCDM::dMeasureCDM$new(a, billings)
# the dMeasureCDM object requires access to both the dMeasure ('a') object
# and the dMeasureBillings ('billings') object
cdm$billings_cdm() %>% head() # chronic disease management opportunities based on chronic conditions
#> Warning in self$dM$check_subscription(clinicians, date_from, date_to,
#> adjustdate = TRUE, : A chosen user has no subscription for chosen date
#> range. Dates changed (minimum one week old).
#> Warning in cdm$billings_cdm(): A chosen user has no subscription for chosen
#> date range. Dates changed (minimum 7 days old).

Chronic disease management opportunities based on a a large number of condition lists, such diabetes_list_cdm. These active condition lists look at appointments_list (which is set by list_appointments method), and determine if a chronic disease management billing has occurred in a time period prior to the appointment.

intID_list <- a$appointments_list %>>%
  dplyr::select(InternalID, AppointmentDate, AppointmentTime, Provider, Age)
cdm$diabetes_list_cdm(intID_list) %>% head()

The diabetes_list_cdm method in turn calls upon the diabetes_list method, which given a dataframe of $InternalID and $Date returns a vector of InternalID which corresponds to the $InternalID which have a history of diabetes.

?dMeasure::diabetes_list

diabetes_list(dMeasure_obj, appointments = NULL)

a$diabetes_list()
#> [1]  2  4 33  5  9  1 34 16  7

9 Immunization methods

?dMeasure::list_vax()

list_vax(
  dMeasure_obj,
  date_from = NA,
  date_to = NA,
  clinicians = NA,
  intID = NULL,
  intID_Date = Sys.Date(),
  appointments_list = NULL,
  include_uptodate = TRUE,
  lazy = FALSE,
  vaxtag = FALSE,
  vaxtag_print = TRUE,
  chosen = self$vaccine_choices
)

a$list_vax() %>% head()

a$list_influenza() %>% head()

a$list_zostavax() %>% head()

a$list_measlesVax() %>% head()

10 Cancer screening methods

?dMeasure::list_mammogram

list_mammogram(
  dMeasure_obj,
  date_from = NA,
  date_to = NA,
  clinicians = NA,
  appointments_list = NULL,
  lazy = FALSE,
  action = FALSE,
  screentag = FALSE,
  screentag_print = TRUE
)

a$list_mammogram() %>% head()
#> Created a temporary table named: ##dbplyr_194
#> Joining, by = c("Patient", "InternalID", "AppointmentDate", "AppointmentTime", "Status", "Provider", "DOB", "Age")

a$list_cst() %>% tail()
#> Created a temporary table named: ##dbplyr_203
#> Joining, by = c("Patient", "InternalID", "AppointmentDate", "AppointmentTime", "Status", "Provider", "DOB", "Age")

a$list_fobt() %>% head()
#> Joining, by = c("Patient", "InternalID", "AppointmentDate", "AppointmentTime", "Status", "Provider", "DOB", "Age")

11 Data Quality methods

?dMeasure::list_dataQuality()

list_dataQuality(
  dMeasure_obj,
  date_from = NA,
  date_to = NA,
  clinicians = NA,
  appointments_list = NULL,
  lazy = FALSE,
  qualitytag = FALSE,
  qualitytag_print = TRUE,
  chosen = self$dataQuality_choices
)

a$list_dataQuality() %>% head()

?dMeasure::list_allergy()

list_allergy(
  dMeasure_obj,
  date_from = NA,
  date_to = NA,
  clinicians = NA,
  appointments_list = NULL,
  lazy = FALSE,
  qualitytag = FALSE,
  qualitytag_print = TRUE
)

a$list_allergy() %>% head()

?dMeasure::list_socialHx()

list_socialHx(
  dMeasure_obj,
  date_from = NA,
  date_to = NA,
  clinicians = NA,
  appointments_list = NULL,
  lazy = FALSE,
  qualitytag = FALSE,
  qualitytag_print = TRUE
)

a$list_socialHx() %>% head()

?dMeasure::list_familyHx()

list_familyHx(
  dMeasure_obj,
  date_from = NA,
  date_to = NA,
  clinicians = NA,
  appointments_list = NULL,
  lazy = FALSE,
  qualitytag = FALSE,
  qualitytag_print = TRUE
)

a$list_familyHx() %>% head()

12 Conditions

diabetes_list method described in Chronic Disease Management section.

?dMeasure::asthma_list

asthma_list(dMeasure_obj, appointments = NULL)

a$asthma_list()
#> [1] 2

?dMeasure::atsi_list

atsi_list(dMeasure_obj, appointments = NULL)

?dMeasure::malignancy_list

malignancy_list(dMeasure_obj, appointments = NULL)

?dMeasure::hiv_list

hiv_list(dMeasure_obj, appointments = NULL)

?dMeasure::haemoglobinopathy_list

haemoglobinopathy_list(dMeasure_obj, appointments = NULL)

?dMeasure::asplenia_list
#> No documentation for 'asplenia_list' in specified packages and libraries

?dMeasure::haemoglobinopathy_list

haemoglobinopathy_list(dMeasure_obj, appointments = NULL)

?dMeasure::transplant_list

transplant_list(dMeasure_obj, appointments = NULL)

?dMeasure::cvd_list

cvd_list(dMeasure_obj, appointments = NULL)

?dMeasure::cardiacdisease_list

cardiacdisease_list(dMeasure_obj, appointments = NULL)

?dMeasure::trisomy21_list

trisomy21_list(dMeasure_obj, appointments = NULL)

?dMeasure::bmi30_list

bmi30_list(dMeasure_obj, appointments = NULL)

?dMeasure::neurologic_list

neurologic_list(dMeasure_obj, appointments = NULL)

?dMeasure::chronicliverdisease_list

chronicliverdisease_list(dMeasure_obj, appointments = NULL)

?dMeasure::chronicrenaldisease_list

chronicrenaldisease_list(dMeasure_obj, appointments = NULL)

?dMeasure::pregnancy_list
#> No documentation for 'pregnancy_list' in specified packages and libraries

?dMeasure::fifteenplus_list

fifteenplus_list(dMeasure_obj, appointments = NULL)

?dMeasure::sixtyfiveplus_list

sixtyfiveplus_list(dMeasure_obj, appointments = NULL)

?dMeasure::seventyfiveplus_list

seventyfiveplus_list(dMeasure_obj, appointments = NULL)

?dMeasure::ATSI_35_44_list

ATSI_35_44_list(dMeasure_obj, appointments = NULL)

?dMeasure::fortyfiveseventyfour_list

fortyfiveseventyfour_list(dMeasure_obj, appointments = NULL)

?dMeasure::cst_eligible_list

cst_eligible_list(dMeasure_obj, appointments = NULL)

?dMeasure::mammogram_eligible_list

mammogram_eligible_list(dMeasure_obj, appointments = NULL)

?dMeasure::familialHypercholesterolaemia_list

familialHypercholesterolaemia_list(dMeasure_obj, appointments = NULL)

?dMeasure::LVH_list

LVH_list(dMeasure_obj, appointments = NULL)

13 Contacts

There are three kinds of contacts : Appointments, Visits and Services.

Appointments are in the Appointment Book, and can be one of several ‘Status’

a$appointment_status_types
#> [1] "Booked"      "Waiting"     "With doctor" "At billing"  "Invoiced"   
#> [6] "Completed"   "Paid"
a$appointment_status # the appointment status type which are seen with 'contact' methods
#> [1] "With doctor" "At billing"  "Invoiced"    "Completed"   "Paid"

Visits are records in the patient progress notes. These can be of several types.

a$visit_types
#>  [1] "Surgery"       "Home"          "Non Visit"     "Hospital"     
#>  [5] "RACF"          "Telephone"     "SMS"           "Email"        
#>  [9] "Locum Service" "Out of Office" "Other"         "Hostel"       
#> [13] "Telehealth"
a$visit_type # the visit types which are seen with 'contact' methods
#> [1] "Surgery"       "Home"          "Hospital"      "RACF"         
#> [5] "Locum Service" "Out of Office" "Hostel"        "Telehealth"

Services are billings.

?dMeasure::list_contact_appointments

list_contact_appointments(
  dMeasure_obj,
  date_from = NA,
  date_to = NA,
  clinicians = NA,
  status = NA
)

a$list_contact_appointments() %>>% head()

x <- a$appointment_status # temporary store
a$appointment_status <- "Completed" # choose appointment status "Completed" only
a$list_contact_appointments() %>>% head()

a$appointment_status <- x # restore previous appointment status setting

a$list_contact_visits() %>% head()

a$list_contact_services() %>% head()

a$contact_type # current contact types which are counted
#> [1] "Services"
a$contact_types # all available contact types
#> [1] "Appointments" "Visits"       "Services"
a$contact_min # number of 'minimum' contact within the specified time period
#> [1] 1
a$contact_minDate # 'minimum' date of most recent contact
#> [1] NA
# note that 'NA' is actually as.Date(-Inf, origin = "1970-01-01")
# which is infinitely into the past
a$contact_minDate <- as.Date("2019-01-01")
a$contact_minDate
#> [1] "2019-01-01"
a$contact_minDate <- as.Date(-Inf, origin = "1970-01-01")
a$contact_minDate
#> [1] NA

a$list_contact_count() %>% head()

a$contact_min <- 5
a$list_contact_count() %>% head()

a$contact_min <- 1

?dMeasure::list_contact_diabetes

list_contact_diabetes(
  dMeasure_obj,
  date_from = NA,
  date_to = NA,
  clinicians = NA,
  min_contact = NA,
  min_date = NA,
  contact_type = NA,
  lazy = FALSE
)

a$list_contact_diabetes() %>% head()

a$list_contact_15plus() %>% head()
#> Created a temporary table named: ##dbplyr_340

a$list_contact_45_74() %>% head()
#> Created a temporary table named: ##dbplyr_351

a$list_contact_65plus() %>% head()
#> Created a temporary table named: ##dbplyr_362

a$list_contact_75plus() %>% head()
#> Created a temporary table named: ##dbplyr_373

a$list_contact_ATSI_35_44() %>% head()
#> Created a temporary table named: ##dbplyr_384

a$list_contact_chroniclungdisease() %>% head()

a$list_contact_cst() %>% head()
#> Created a temporary table named: ##dbplyr_406

14 Practice Incentive Program Quality Improvement Measures

Quality Improvement Measures are provided by the dMeasureQIM object.

qim <- dMeasureQIM::dMeasureQIM$new(a)
# the dMeasureQIM object is created
# with 'access' to the dMeasure object, in this case 'a'

These methods assist in reporting and monitoring of Quality Improvement Measures.

One group of methods list patients relevant to the Quality Improvement Measures.

The most basic list is of active patients (as defined by the contact methods, such as list_contact_count).

In the example below, ‘all’ contact types are counted. This is a very broad definition, and is only used because the ‘samples’ database used to create this document is very small.

?dMeasureQIM::list_qim_active

list_qim_active(
  dMeasureQIM_obj,
  contact = NA,
  date_from = NA,
  date_to = NA,
  clinicians = NA,
  min_contact = NA,
  min_date = NA,
  contact_type = NA,
  lazy = FALSE
)

a$contact_type <- a$contact_types # includes 'all' contact types as valid (appointment, visit, billing)
qim$list_qim_active() # the list of patients, with Quality Improvement Measure specified groupings

Another group of methods provide aggregated/anonymized report of the relevant patients.

qim$report_qim_active() # an 'anonymized'/aggregated report of the active patients

# 'n' is the number of patients in the category
# 'Proportion' is the proportion of patients in the category

The demographic groupings for report can be changed from the default

qim$qim_demographicGroup # the default setting
#> [1] "Age5"          "Sex"           "Ethnicity"     "MaritalStatus"
#> [5] "Sexuality"
qim$qim_demographicGroupings
#> [1] "Age5"          "Sex"           "Ethnicity"     "MaritalStatus"
#> [5] "Sexuality"
qim$qim_demographicGroup <- c("Sex", "Ethnicity")
qim$report_qim_active()

DT::datatable(qim$list_qim_diabetes(),
              extension = "Scroller",
              options = list(scroller = TRUE, scrollX = TRUE))

qim$report_qim_diabetes()

qim$qim_ignoreOld <- FALSE
DT::datatable(qim$list_qim_diabetes(),
              extension = "Scroller",
              options = list(scroller = TRUE, scrollX = TRUE))

qim$report_qim_diabetes()

qim$qim_contact <- FALSE # use 'appointment' list, not 'contact' list
a$choose_date(as.Date("2019-01-01"))
#> [[1]]
#> [1] "2019-01-01"
#> 
#> [[2]]
#> [1] "2020-04-11"

DT::datatable(qim$list_qim_diabetes_appointments(),
              extension = "Scroller",
              options = list(scroller = TRUE, deferRender = TRUE,
                             scrollX = TRUE, scrollY = 200))

?dMeasureQIM::list_qim_diabetes_appointments

list_qim_diabetes_appointments(
  dMeasureQIM_obj,
  contact = NA,
  date_from = NA,
  date_to = NA,
  clinicians = NA,
  min_contact = NA,
  min_date = NA,
  contact_type = NA,
  ignoreOld = NA,
  lazy = FALSE
)

qim$qim_contact <- TRUE # return to 'contact' list
a$choose_date(as.Date("2001-01-01")) # expand date list
#> [[1]]
#> [1] "2001-01-01"
#> 
#> [[2]]
#> [1] "2020-04-11"

qim$list_qim_cst()
#> Created a temporary table named: ##dbplyr_717

DT::datatable(qim$list_qim_cst_appointments(),
              extension = "Scroller",
              options = list(scroller = TRUE, deferRender = TRUE,
                             scrollX = TRUE, scrollY = 200))
#> Created a temporary table named: ##dbplyr_747

qim$report_qim_cst()
#> Created a temporary table named: ##dbplyr_782

# very wide table! use scroller to see to the right...
DT::datatable(qim$list_qim_15plus(),
              extension = "Scroller",
              options = list(scroller = TRUE, scrollX = TRUE))
#> Created a temporary table named: ##dbplyr_812

DT::datatable(qim$list_qim_15plus_appointments(),
              extension = "Scroller",
              options = list(scroller = TRUE, deferRender = TRUE,
                             scrollX = TRUE, scrollY = 200))
#> Created a temporary table named: ##dbplyr_853

DT::datatable(qim$report_qim_15plus())
#> Created a temporary table named: ##dbplyr_899

qim$list_qim_65plus()
#> Created a temporary table named: ##dbplyr_940

DT::datatable(qim$list_qim_65plus_appointments(),
              extension = "Scroller",
              options = list(scroller = TRUE, deferRender = TRUE,
                             scrollX = TRUE, scrollY = 200))
#> Created a temporary table named: ##dbplyr_971

qim$report_qim_65plus()
#> Created a temporary table named: ##dbplyr_1007

qim$list_qim_copd()

DT::datatable(qim$list_qim_copd_appointments(),
              extension = "Scroller",
              options = list(scroller = TRUE, deferRender = TRUE,
                             scrollX = TRUE, scrollY = 200))

qim$report_qim_copd()

?dMeasureQIM::list_qim_cvdRisk

list_qim_cvdRisk(
  dMeasureQIM_obj,
  contact = NA,
  date_from = NA,
  date_to = NA,
  clinicians = NA,
  min_contact = NA,
  min_date = NA,
  contact_type = NA,
  ignoreOld = NA,
  lazy = FALSE
)

# remove some demographics and alcohol recordings because the table is very wide...
# note that the framingham risk equation calculation result 'frisk' is on the
# extreme right hand side
DT::datatable(qim$list_qim_cvdRisk() %>%
                dplyr::select(-c(RecordNo, MaritalStatus, Sexuality)),
              extension = "Scroller",
              options = list(scroller = TRUE, scrollX = TRUE))
#> Created a temporary table named: ##dbplyr_1133
#> Created a temporary table named: ##dbplyr_1153

DT::datatable(qim$list_qim_cvdRisk_appointments(),
              extension = "Scroller",
              options = list(scroller = TRUE, deferRender = TRUE,
                             scrollX = TRUE, scrollY = 200))
#> Created a temporary table named: ##dbplyr_1235
#> Created a temporary table named: ##dbplyr_1255

qim$report_qim_cvdRisk()
#> Created a temporary table named: ##dbplyr_1342
#> Created a temporary table named: ##dbplyr_1362

qim$qim_cvdRisk_measureTypes
#> [1] "Include ATSI 35-44" "Exclude 75+"        "Exclude known CVD"
qim$qim_cvdRisk_measure # default group settings
#> [1] "Include ATSI 35-44" "Exclude 75+"        "Exclude known CVD"

?framinghamRiskEquation::framingham_riskequation

framingham_riskequation(df, years = 5, outcome = "CVD")

framingham_riskequation(data.frame(InternalID = 1, BP = "135/80", Sex = "Female",
 Age = 55,
 SmokingStatus = "Smoker", CholHDLRatio = 230/48, Diabetes = TRUE, LVH = FALSE,
  CardiovascularDisease = FALSE, PersistentProteinuria = FALSE, eGFRValue = NA,
   eGFRUnits = NA, UrineAlbuminValue = NA, UrineAlbuminUnits = NA,
   FamilialHypercholesterolaemia = NA, Cholesterol = 5.96, Ethnicity = NA),
    outcome = "CHD", years = 10)
    # this comes from "Cardiovascular disease risk profiles" (Anderson 1991)
    # the worked answer in the paper is 0.22. this function returns 0.2189125
    # the same risk-factors with outcome = "CVD" and years = 5 returns 0.180
    #  (cvdcheck.org.au reports 18%)
    # the same risk-factors except Sex = "Male" with outcome = "CVD" and years = 5 returns 0.202
    #  (cvdcheck.org.au reports 20%)

framingham_riskequation(data.frame(InternalID = 2, BP = "130/80", Sex = "Male",
 Age = 55,
 SmokingStatus = "Smoker", CholHDLRatio = 240/45, Diabetes = FALSE, LVH = FALSE,
  CardiovascularDisease = FALSE, PersistentProteinuria = FALSE, eGFRValue = NA,
   eGFRUnits = NA, UrineAlbuminValue = NA, UrineAlbuminUnits = NA,
   FamilialHypercholesterolaemia = NA, Cholesterol = 6.22, Ethnicity = NA),
    outcome = "CHD", years = 10)
    # this comes from "An Updated Coronary Risk Profile" (Anderson 1991)
    # the worked answer in the paper is 0.192, this function returns 0.1919
    # the same risk-factors with outcome = "CVD" and years = 5 returns 0.133
    #  (cvdcheck.org.au reports 13%)
    # the same risk-factors except LVH = TRUE (outcome = CVD, years = 5) returns 0.211
    #  (cvdcheck.org.au reports 21%)

framingham_riskequation(data.frame(InternalID = 3, BP = "130/80", Sex = "Female",
 Age = 55,
 SmokingStatus = "Smoker", CholHDLRatio = 240/45, Diabetes = FALSE, LVH = FALSE,
  CardiovascularDisease = FALSE, PersistentProteinuria = FALSE, eGFRValue = NA,
   eGFRUnits = NA, UrineAlbuminValue = NA, UrineAlbuminUnits = NA,
   FamilialHypercholesterolaemia = NA, Cholesterol = 6.22, Ethnicity = NA),
    outcome = "CHD", years = 10)
    # this comes from "An Updated Coronary Risk Profile" (Anderson 1991)
    # the worked answer in the paper is 0.135, this function returns 0.1349
    # the same risk-factors with outcome = "CVD" and years = 5 returns 0.088
    #  (cvdcheck.org.au reports 9%)
    # the same risk-factors except LVH = TRUE (outcome = CVD, years = 5) returns 0.150
    #  (cvdcheck.org.au reports 15%)

function (df, years = 5, outcome = "CVD") 
{
    fre_coefficients <- data.frame(row.names = c("CHD", "CVD"), 
        theta0 = c(0.9145, 0.6536), theta1 = c(-0.2784, -0.2402), 
        beta0 = c(15.5305, 18.8144), female = c(28.4441, -1.2146), 
        log_age = c(-1.4792, -1.8443), log_age2 = c(0, 0), log_age_female = c(-14.4588, 
            0.3668), log_age2_female = c(1.8515, 0), log_SBP = c(-0.9119, 
            -1.4032), cigarettes = c(-0.2767, -0.3899), log_TCHDLratio = c(-0.7181, 
            -0.539), diabetes = c(-0.1759, -0.3036), diabetes_female = c(-0.1999, 
            -0.1697), ECGLVH = c(-0.5865, -0.3362))
    fre_b <- fre_coefficients[outcome, ]
    f <- df %>>% tidyr::separate(BP, into = c("Systolic", "Diastolic"), 
        sep = "/", convert = TRUE) %>>% dplyr::mutate(mu = fre_b$beta0 + 
        fre_b$female * (Sex == "Female") + fre_b$log_age * log(Age) + 
        fre_b$log_age_female * log(Age) * (Sex == "Female") + 
        fre_b$log_age2_female * log(Age)^2 * (Sex == "Female") + 
        fre_b$log_SBP * log(Systolic) + fre_b$cigarettes * (SmokingStatus == 
        "Smoker") + fre_b$log_TCHDLratio * log(CholHDLRatio) + 
        fre_b$diabetes * Diabetes + fre_b$diabetes_female * Diabetes * 
        (Sex == "Female") + fre_b$ECGLVH * LVH, sigma = exp(fre_b$theta0 + 
        fre_b$theta1 * mu), u = (log(years) - mu)/sigma, frisk = 1 - 
        exp(-exp(u))) %>>% dplyr::mutate(friskHI = dplyr::case_when(CardiovascularDisease ~ 
        ">15%", Diabetes & (Age > 60) ~ ">15%", Diabetes & UrineAlbuminValue > 
        20 & UrineAlbuminUnits == "mcg/min" ~ ">15%", Diabetes & 
        Sex == "Male" & UrineAlbuminValue > 2.5 & UrineAlbuminUnits == 
        "mg/mmol" ~ ">15%", Diabetes & Sex == "Female" & UrineAlbuminValue > 
        3.5 & UrineAlbuminUnits == "mg/mmol" ~ ">15%", PersistentProteinuria == 
        TRUE ~ ">15%", eGFRValue < 45 & eGFRUnits == "mL/min" ~ 
        ">15%", FamilialHypercholesterolaemia == TRUE ~ ">15%", 
        Systolic >= 180 | Diastolic >= 110 ~ ">15%", Cholesterol > 
            7.5 ~ ">15%", Ethnicity %in% c("Aboriginal", "Torres Strait Islander", 
            "Aboriginal/Torres Strait Islander") & Age > 74 ~ 
            ">15%", TRUE ~ as.character(NA))) %>>% dplyr::select(InternalID, 
        frisk, friskHI)
    return(f)
}
<bytecode: 0x000000001f43c960>
<environment: namespace:framinghamRiskEquation>

15 Close the database connections

a$close()