Recruitment

The quality of patient recruitment in the anatomical lung resection process, by each Centre, is assessed on the basis of:

• Date of surgical intervention (activity pace).

• Date of registry of each patient on the platform (registration pace).

• Average number of days elapsed between the two previous dates (prospective nature).

• Annual list of the number of patients registered in ReSECT, according to date of surgery, and number of patients operated on that same year, according to the corresponding report issued by the Clinical Documentation Department of each Centre. (recruitment commitment).

Important

In order for each Centre’s list of patients on the platform to accurately reflect which patient has been included in the anatomical lung resection process, it is NECESSARY to save the clinical data form once inclusion in the process has been confirmed.

Activity Pace

The commitment of each Centre to the registration of its surgical activity in ReSECT is determined by the absence of long segments with a low slope.

Code

ritmo_fecha_iq <- rpaCirugia %>% 
  filter(as.Date(fecha_de_intervencion_quirurgica) >= "2023-01-01") %>% 
  count(hospital, fecha_iq = as.Date(fecha_de_intervencion_quirurgica)) %>%
  group_by(hospital) %>%
  mutate(
    casos = sum(n),
    acum = cumsum(n)) %>% 
  arrange(-casos) %>%
  ungroup()

hospitales_decr_casos <- unlist(ritmo_fecha_iq %>% distinct(hospital))

p1 <- ritmo_fecha_iq %>% filter(hospital %in% hospitales_decr_casos[1:10]) %>%
  ggplot(aes(x = fecha_iq, y = acum, 
             color = fct_reorder(as.factor(hospital), casos, .fun=max)
             )) +
    geom_line(size=1) +
    geom_point()+
    scale_color_manual(values = c(rev(verde5), purple5)) +
    guides(color = guide_legend(reverse=TRUE), size = guide_legend(reverse=TRUE),) + 
    scale_y_continuous(breaks = pretty_breaks())+
    scale_x_date(date_breaks = "2 month", date_labels = "%b%y")+
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45))+
    labs(x = NULL, y = "Procedures\n", color = NULL,
         subtitle = "Centres in position 1 to 10 according to number of procedures registered") 



p2<- ritmo_fecha_iq %>% filter(hospital %in% hospitales_decr_casos[11:20]) %>%
  ggplot(aes(x = fecha_iq, y = acum, 
             color = fct_reorder(as.factor(hospital), casos, .fun=max)
             )) +
    geom_line(size=1) +
    geom_point()+
    scale_color_manual(values = c(rev(gris5), azul5)) +
    scale_y_continuous(breaks = pretty_breaks())+
    scale_x_date(date_breaks = "2 month", date_labels = "%b%y", limits=c(as.Date("2023-01-01"), Sys.Date()))+ 
    guides(color = guide_legend(reverse=TRUE), size = guide_legend(reverse=TRUE)) +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45))+
    labs(x = "\nDate of Surgery", y = "Procedures\n", color = NULL,
         subtitle = "Centres in position 11 to 20 according to number of procedures registered")

grid.arrange(p1, p2, nrow = 2) 

Registration Pace

A constant registration of patients, as a criterion for the quality of recruitment, is determined by the absence of long segments with steep or low slopes.

Note

In case of patients with more than one surgical procedure, only the first one is considered for the representation of the following plot.

Code

rpaCirugia <- rpaCirugia %>% 
  select(patient_id, everything()) %>%
  distinct(patient_id, .keep_all = TRUE)


timing <- a_rpaCirugia %>% 
  group_by(patient_id) %>% 
  slice(1) %>% 
  select(patient_id, 
         creation_time, 
         identificador_del_procedimiento_principal, 
         fecha_de_intervencion_quirurgica) %>%
  mutate(fecha_de_intervencion_quirurgica = as.Date(fecha_de_intervencion_quirurgica)) %>%
         # patient_id = as.numeric(patient_id)
  ungroup() %>%
  left_join(rpaCirugia[, c("hospital",
                           "patient_id", 
                           "fecha_de_intervencion_quirurgica",    
                           "identificador_del_procedimiento_principal")], 
            by = c("patient_id", "identificador_del_procedimiento_principal")) %>%
  mutate(
    dif_fechas_iq = as.Date(fecha_de_intervencion_quirurgica.x) - as.Date(fecha_de_intervencion_quirurgica.y),
    dif_creation = as.Date(creation_time) - as.Date(fecha_de_intervencion_quirurgica.x)) %>%
  filter(as.Date(fecha_de_intervencion_quirurgica.y) >= "2023-01-01")


saveRDS(timing, file = "timing.RDS")


ritmo_fecha_creacion <- timing %>%
  count(hospital, fecha_creacion = as.Date(creation_time)) %>%
  group_by(hospital) %>%
  mutate(
    casos = sum(n),
    acum = cumsum(n)) %>% 
  arrange(-casos) %>%
  ungroup() %>%
  arrange(-casos)
  
p1 <- ritmo_fecha_creacion %>%  filter(hospital %in% hospitales_decr_casos[1:10]) %>%
  ggplot(aes(x = fecha_creacion, y = acum, 
             color = fct_reorder(as.factor(hospital), casos, .fun=max))) +
    geom_line(size=1) +
    geom_point()+
    scale_color_manual(values = c(rev(verde5), purple5)) +
    guides(color = guide_legend(reverse=TRUE), size = guide_legend(reverse=TRUE),) +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45))+
    labs(x = NULL, y = "Procedures\n", color = NULL,
         subtitle = "Centres in position 1 to 10 according to number of procedures registered")

p2 <- ritmo_fecha_creacion %>%  filter(hospital %in% hospitales_decr_casos[11:20]) %>%
  ggplot(aes(x = fecha_creacion, y = acum, 
             color = fct_reorder(as.factor(hospital), casos, .fun=max))) +
    geom_line(size=1) +
    geom_point()+
    scale_color_manual(values = c(rev(gris5), azul5)) +
    scale_y_continuous(breaks = pretty_breaks())+
    guides(color = guide_legend(reverse=TRUE), size = guide_legend(reverse=TRUE),) +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45))+
    labs(x = "\nDate of Registration", y = "Procedures\n", color = NULL,
         subtitle = "\nCentres in position 11 to 20 according to number of procedures registered")

grid.arrange(p1, p2, nrow=2)

Prospective Nature

The next plots represents the average time elapsed from the date of surgery to the date of creation of each record in the platform (bars), and the number of patients undergoing anatomical lung resection in each Centre (numbers). For a relevant number of patients, shorter bars indicate better timing in recruitment.

Overall

Code

time_recruitment()

2023

Code

time_recruitment(2023)

2024

Code

time_recruitment(2024)

Recruitment Commitment

Recruitment commitment is determined on an annual basis according to the reports to be issued by the Clinical Documentation Department of each Centre.

Important

The audit process refers to lobectomy and pneumonectomy type resections, and therefore does not include anatomical segmentectomies because the current classification of surgical procedures (ICD10) does not adequately distinguish between this type of resection and wedge resections. The calculation for the estimation of the surgical volume can be found here.

2023

Code

year <- 2023

segmentos <- datosClinicos_rpa %>%
  filter(year(fecha_de_intervencion_quirurgica)== year) %>%
  group_by(hospital) %>%
  count(procedimiento_pulmonar) %>%
  filter(procedimiento_pulmonar == "Segmentectomía Anatómica") %>%
  select(hospital, segmentectomias = n)

df_audit <- datosClinicos_rpa %>% filter(
  year(fecha_de_intervencion_quirurgica)== year &
  procedimiento_pulmonar %in% c("Lobectomía", "Neumonectomía", "Bilobectomía")) %>%
  count(hospital, name = "lobes_neumos") %>%
  full_join(segmentos, by = "hospital") %>%
  left_join(hospitales, by = "hospital") %>%
  select(HOSPITAL = hospital,
         LOBE_PNEUMO = lobes_neumos,
         SEGMENT = segmentectomias,
         AUDIT_DATE = paste0("FECHA_AUDIT_", year),
         AUDIT = paste0("AUDIT_",year)) %>%
  mutate(
    LOBE_PNEUMO = ifelse(is.na(LOBE_PNEUMO),0,LOBE_PNEUMO),
    PERCENT = round(100 * LOBE_PNEUMO/AUDIT,1),
    SEGMENT = ifelse(is.na(SEGMENT),0,SEGMENT),
    VOLUME = ifelse(LOBE_PNEUMO>AUDIT, LOBE_PNEUMO+SEGMENT, floor(AUDIT + (SEGMENT*AUDIT/LOBE_PNEUMO))),
    AUDIT_DATE = as.Date(AUDIT_DATE)
    ) %>%
  arrange(desc(PERCENT))


sketch <- htmltools::withTags(
  table(
    class = 'display',
    thead(
        tr(
            th(rowspan = 2, 'Hospital'),
            th(colspan = 2, 'ReSECT'),
            th(colspan = 2, 'Audit'),
            th(rowspan = 2, 'Recruitment (%)'),
            th(rowspan = 2, 'Volume')
        ),

        tr(
            lapply(c('Lobe-Neumo', 'Segments'), th),
            lapply(c('Date', 'Cases'), th)
        )

    )

  )

  )

df_audit %>% datatable(
    container = sketch,
    class = 'cell-border stripe',
    caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-center: left; width:800px',
            htmltools::br(),
            htmltools::p(style="font-style: italic", paste('Year: ', year, ' - Updated: ', Sys.Date()))),
    rownames = FALSE,
    extensions = c('Buttons', 'FixedHeader'),
    options = list(
         columnDefs = list(list(className = 'dt-center', targets = "_all")),
         dom = 'lftBip',
         pageLength = 10,
         order = list(6, 'desc'),
         lengthMenu = list(c(5, 10, 20, 30, -1),

                         c('5', '10','20','30','All')),
          buttons = list(list(
              extend = 'collection',
              buttons = c('csv', 'excel', 'pdf'),
              text = 'Download'))
   ),

   colnames = c("Hospital", "Lobe-Pneumo", "Segments", "Date", "Cases", "Recruitment (%)", "Volume")) %>%
    formatStyle(columns = 1:7, fontSize = "80%")

2024

Code

year <- 2024

segmentos <- datosClinicos_rpa %>%
  filter(year(fecha_de_intervencion_quirurgica)== year) %>%
  group_by(hospital) %>%
  count(procedimiento_pulmonar) %>%
  filter(procedimiento_pulmonar == "Segmentectomía Anatómica") %>%
  select(hospital, segmentectomias = n)

df_audit <- datosClinicos_rpa %>% filter(
  year(fecha_de_intervencion_quirurgica)== year &
  procedimiento_pulmonar %in% c("Lobectomía", "Neumonectomía", "Bilobectomía")) %>%
  count(hospital, name = "lobes_neumos") %>%
  full_join(segmentos, by = "hospital") %>%
  left_join(hospitales, by = "hospital") %>%
  select(HOSPITAL = hospital,
         LOBE_PNEUMO = lobes_neumos,
         SEGMENT = segmentectomias,
         AUDIT_DATE = paste0("FECHA_AUDIT_", year),
         AUDIT = paste0("AUDIT_",year)) %>%
  mutate(
    LOBE_PNEUMO = ifelse(is.na(LOBE_PNEUMO),0,LOBE_PNEUMO),
    PERCENT = round(100 * LOBE_PNEUMO/AUDIT,1),
    SEGMENT = ifelse(is.na(SEGMENT),0,SEGMENT),
    VOLUME = ifelse(LOBE_PNEUMO>AUDIT, LOBE_PNEUMO+SEGMENT, floor(AUDIT + (SEGMENT*AUDIT/LOBE_PNEUMO))),
    AUDIT_DATE = as.Date(AUDIT_DATE)
    ) %>%
  arrange(desc(PERCENT))


sketch <- htmltools::withTags(
  table(
    class = 'display',
    thead(
        tr(
            th(rowspan = 2, 'Hospital'),
            th(colspan = 2, 'ReSECT'),
            th(colspan = 2, 'Audit'),
            th(rowspan = 2, 'Recruitment (%)'),
            th(rowspan = 2, 'Volume')
        ),

        tr(
            lapply(c('Lobe-Neumo', 'Segments'), th),
            lapply(c('Date', 'Cases'), th)
        )

    )

  )

  )

df_audit %>% datatable(
    container = sketch,
    class = 'cell-border stripe',
    caption = htmltools::tags$caption(
    style = 'caption-side: bottom; text-center: left; width:800px',
            htmltools::br(),
            htmltools::p(style="font-style: italic", paste('Year: ', year, ' - Updated: ', Sys.Date()))),
    rownames = FALSE,
    extensions = c('Buttons', 'FixedHeader'),
    options = list(
         columnDefs = list(list(className = 'dt-center', targets = "_all")),
         dom = 'lftBip',
         pageLength = 10,
         order = list(6, 'desc'),
         lengthMenu = list(c(5, 10, 20, 30, -1),

                         c('5', '10','20','30','All')),
          buttons = list(list(
              extend = 'collection',
              buttons = c('csv', 'excel', 'pdf'),
              text = 'Download'))
   ),

   colnames = c("Hospital", "Lobe-Pneumo", "Segments", "Date", "Cases", "Recruitment (%)", "Volume")) %>%
    formatStyle(columns = 1:7, fontSize = "80%")