R/is_hifld_id.R

In uclalawcovid19behindbars/behindbarstools: Tools for the UCLA Behind Bars Data Team

#' Returns TRUE if the given ID is a valid HIFLD ID 
#' 
#' Returns TRUE if the given ID is a valid HIFLD, includes a parameter to 
#' return FALSE vs. NA if the given ID is NA. 
#'
#' @param id integer or character string of the ID to check 
#' @param hifld_data data frame with HIFLD information 
#' @param missing_as_na logical, whether NA should return NA (vs. FALSE)
#'
#' @return logical, TRUE if the given ID is a valid HIFLD ID  
#' @export
#'
#' @examples
#' is_hifld_id(10002598) 
#' is_hifld_id(c(10002598, 123, NA))

is_hifld_id <- function(id, hifld_data = NULL, missing_as_na = T) {
    
    if (is.null(hifld_data)) {
        hifld_data <- behindbarstools::read_hifld_data()
    }
    
    valid_ids <- hifld_data %>% 
        select(hifld_id) %>% 
        distinct() %>% 
        unlist()
    
    return(ifelse(missing_as_na & is.na(id), NA, id %in% valid_ids))
}