R/modules.R

Defines functions discounts discountsUI patientInfo patientInfoUI

patientInfoUI <- function(id) {
  ns <- shiny::NS(id)
  
  tagList(div(
    class = "content",
    div(class = "row",
        div(class = "name-container",
            uiOutput(ns(
              "name"
            )))),
    col(6,
      box(h1("Basic Info"),
          DT::dataTableOutput(ns("info"))),
      box(h1("Product Types"),style = "overflow:hidden",
          div(
                  uiOutput(ns("no_type"), TRUE),
                  c3Output(ns("patient_type"))
          )
      )
    ),
    col(6,
      box(h1("Medical Info"),
          DT::dataTableOutput(ns("recommendation"))),
      box(h1("Patient History"),
          CannaModules::patientHistoryUI(ns("frontdesk")))
    )
  ))
}

patientInfo <-
  function(input,
           output,
           session,
           pool,
           patientId,
           bucket, 
           fade) {
    trigger_patient_info_returning <- reactiveVal(0)
    patient_info_returning <- reactive({
      req(patientId())
      trigger_patient_info_returning()
      q_f_patient_info(pool, patientId())
    })
    
    output$name <- renderUI({
      if (isTruthy(patientId())) {
        h1(
          paste(
            patient_info_returning()$firstName,
            patient_info_returning()$lastName
          )
        )
      } else {
        h1("Please select a returning")
      }
    })
    
    output$info <- DT::renderDataTable(
      patient_info_returning() %>%
        mutate_(
          emailDeal = ~ if_else(emailDeal == 1, "YES", "NO"),
          textDeal = ~ if_else(textDeal == 1, "YES", "NO"),
          birthday = ~ paste0(birthday, " (", age, " years old)")
        ) %>%
        select_(
          # Name = ~ name,
          `California ID` = ~ id,
          DOB = ~ birthday,
          Address = ~ address,
          City = ~ city,
          Zip = ~ zip,
          Email = ~ email,
          `Deals by Email` = ~ emailDeal,
          Phone = ~ phone,
          `Deals by Text` = ~ textDeal
        ) %>%
        t() %>% as.data.frame(stringsAsFactors = FALSE) %>% tidyr::replace_na(list(`V1` =
                                                                                     "N/A")),
      options = list(dom = 't', columnDefs = list(
        list(
          targets = 0, className = "dt-center",
          render = JS(
            "function(data, type, row, meta) {
            return '<span class = \\'dt-rowname\\'>' + data + ':<\\span>';
  }"
          )
          ),
        list(targets = 1, className = "dt-left")
          )),
      rownames = TRUE,
      class = "table dt-row", selection = 'none'
      )
    
    output$preference <- DT::renderDataTable({
      info <- patient_info_returning()
      data.frame(
        check.names = FALSE,
        Strain = paste0(c("Indica", "Sativa", "Hybrid")[which(c(info$indica ==
                                                                  1, info$sativa == 1, info$hybrid == 1))], collapse = ", "),
        Product = paste0(c(
          "Flower", "Concentrate", "Edible", "Other"
        )[which(c(
          info$flower == 1,
          info$concentrate ==
            1,
          info$edible ==
            1,
          info$other ==
            1
        ))],
        collapse = ", "),
        `Referred By` = if_else(info$recommender=="", NA_character_, info$recommender)
      ) %>% t() %>% as.data.frame(stringsAsFactors = FALSE) %>% tidyr::replace_na(list(`V1` =
                                                                                         "N/A"))
      
    }, options = list(dom = 't', columnDefs = list(
      list(
        targets = 0, className = "dt-center",
        render = JS(
          "function(data, type, row, meta) {
          return '<span class = \\'dt-rowname\\'>' + data + ':<\\span>';
  }"
        )
        ),
      list(targets = 1, className = "dt-left")
        )), rownames = TRUE, class = "table dt-row", selection = 'none')
    
    output$recommendation <- DT::renderDataTable({
      patient_info_returning() %>%
        mutate_(
          medicalCondition = ~if_else(medicalCondition == "", NA_character_, medicalCondition)
        ) %>%
        select_(
          `Expiration Date` = ~ expirationDate,
          Physician = ~ physician,
          `Medical Card ID #` = ~ recId,
          `Medical Condtion` = ~ medicalCondition
        ) %>%
        t() %>% as.data.frame(stringsAsFactors = FALSE) %>% tidyr::replace_na(list(`V1` =
                                                                                     "N/A"))
    }, options = list(dom = 't', columnDefs = list(
      list(
        targets = 0, className = "dt-center",
        render = JS(
          "function(data, type, row, meta) {
          return '<span class = \\'dt-rowname\\'>' + data + ':<\\span>';
  }"
        )
        ),
      list(targets = 1, className = "dt-left")
        )), rownames = TRUE, class = "table dt-row", selection = 'none')
    
    # images
    
    output$id_image_out <- renderUI({
      if (isTruthy(patientId()) &&
          isTruthy(patient_info_returning()$photoPath)) {
        tags$img(
          src = paste0(
            "https://s3-us-west-2.amazonaws.com/",
            bucket,
            "/",
            patient_info_returning()$photoPath
          ),
          height = "100%",
          width = "100%"
        )
      } else {
        tags$img(src = "https://upload.wikimedia.org/wikipedia/commons/thumb/a/ac/No_image_available.svg/1000px-No_image_available.svg.png",
                 height = "100%",
                 width = "100%")
      }
    })
    
    output$recommendation_image_out <- renderUI({
      if (isTruthy(patientId()) &&
          isTruthy(patient_info_returning()$medicalPath)) {
        tags$img(
          src = paste0(
            "https://s3-us-west-2.amazonaws.com/",
            bucket,
            "/",
            patient_info_returning()$medicalPath
          ),
          height = "100%",
          width = "100%"
        )
      } else {
        tags$img(src = "https://upload.wikimedia.org/wikipedia/commons/thumb/a/ac/No_image_available.svg/1000px-No_image_available.svg.png",
                 height = "100%",
                 width = "100%")
      }
    })
    
    patient_sales <- reactive({
      req(patientId())
      q_f_patient_sales(pool, patientId()) 
    })
    
    output$patient_type <- renderC3({
      req(patientId())
      req(patient_sales()$profit)
      patient_sales() %>% 
        mutate_(type = ~tools::toTitleCase(type)) %>%
        spread_("type", "profit") %>%
        select_(~contains("Flower"), ~contains("Concentrate"),~contains("Edible"),~contains("Beverage"),
                ~contains("Soap"), ~contains("Vaporizer"), ~contains("Tincture"), ~contains("Ointment"),
                ~contains("Joint"), ~contains("Tobacco"), ~contains("Paraphernalia"), ~contains("Misc")) %>% 
        summarise_all(function(x) {x[!is.na(x)][1]}) %>% c3() %>%
        c3_pie(format=DT::JS("function(value,ratio,id) {return '$' + value;}"))
      
    })
    
    output$patient_points <- renderC3({
      req(patientId())
      
      patient_info_returning() %>%
        select_(~points) %>% 
        mutate_(points=~if_else(is.na(points),0,points)) %>%
        c3() %>% 
        c3_gauge(min = 0, max = 10000, label = list(
          format = DT::JS(
            "function(value, ratio) {
            return value;
            }"
          )
        ))
    })
    
    output$no_type <- renderUI({
      req(!isTruthy(patient_sales()$profit))
      h4("No Data Available", style = "margin-top:5%;text-align:center;")
    })
    
    callModule(CannaModules::patientHistory,
               "frontdesk",
               pool,
               reactive({
                 req(patientId())
                 patientId()
               }), fade = FALSE)
    
    return(reactive(patient_info_returning()))
    
  }

discountsUI <- function(id, coupon, reason = NULL, discount = NULL, unit = NULL) {
  ns <- NS(id)
  
  tagList(
    div(class = "row",
    div(class = "row", style = "margin: 0 auto",
        col(7,
          style = "padding-left:0;padding-right:0",
          numericInput(ns("discount"), "Discount", discount, 0, 100, step = "any")
        ),
        col(3,
          style = paste0("padding-left:0;padding-right:0;margin-top:24px"),
          selectizeInput(ns("type"), NULL, selected = unit, choices = c("%", "$"), options = list(
            onChange = I(paste0("function(value) {
                      if (value === '$') {
                        $('#", ns("discount"),"').attr('max', $('#DataTables_Table_3 > tbody > tr:nth-child(1) > td.reciept-numbers > h5.subtotal').html().replace('$',''));
                      } else {
                        $('#", ns("discount"),"').attr('max', '100');                        
                      };
                     }"))
          )))
        )),
    conditionalPanel(
      condition = "input.discount",
      ns = ns,
      div(class="row",
      div(class = "row", style = "margin: 0 auto",
          selectizeInput(ns("reason"), "Reason for discount", choices = {
            if (isTruthy(reason) && length(coupon()) > 0 && isTRUE(as.numeric(reason) %in% coupon())) coupon() else structure(c(reason, coupon()), names = c(reason, names(coupon())))
          }, selected = reason, options = list(
            create = TRUE,
            createOnBlur = TRUE,
            onInitialize = if (!isTruthy(reason)) I('function() {this.setValue("");}')
          ))
      ))))
}

discounts <- function(input,
                     output,
                     session, coupon) {
  return(reactive({
    req(input$discount, input$type, input$reason)
    list(
    discount = input$discount,
    unit = input$type,
    reason = if (input$reason %in% coupon()) NA else input$reason,
    idcoupon = if (input$reason %in% coupon()) input$reason else NA
  )}))
}
CannaData/CannaPOS documentation built on Feb. 19, 2018, 1:02 p.m.