# # This is the server logic of a Shiny web application. You can run the # application by clicking 'Run App' above. # # Find out more about building applications with Shiny here: # # http://shiny.rstudio.com/ # library(shiny) # Define server logic required to draw a histogram shinyServer(function(input, output) { filenames <- list.files("./CodeList", pattern = "*.xlsx", full.names = T) sheet_names <- lapply(filenames, excel_sheets) # Creates a list of the sheet names codelist_files <- NULL for (i in seq_along(filenames)) { a <- lapply(excel_sheets(filenames[[i]]), read_excel, path = filenames[[i]], col_types = "text") # Reads the sheets of the excel files names(a) <- c(sheet_names[[i]]) # Renames them according to the sheet names extracted above codelist_files <- c(codelist_files, a) } emp<-read.csv("emp.csv") |> select(Employee.ID , Name) #acc<-read.csv("accounts.csv") |> select(-1) acc<-read.csv("acc1.csv") saptemplate <- read_excel("template.xlsx", sheet = "Field_Definitions") snames <- unique(saptemplate$`Sheet Name`) olddat<- reactive({ req(input$oldfile) tryCatch( { df <- read.csv(input$oldfile$datapath, sep = ";", fileEncoding = 'ISO8859-2', dec = ",") }, error = function(e) { # return a safeError if a parsing error occurs stop(safeError(e)) } ) df<-df |> left_join(emp, by=c(Sales.Rep = "Name")) |> rename(salerep=Sales.Rep) |> mutate(Employee.ID=ifelse(is.na(Employee.ID),"90112",Employee.ID)) |> rename(Sales.Rep=Employee.ID) df }) output$contents <- renderDataTable({ req(olddat()) datatable(olddat(), extensions = "Buttons", options = list( paging = TRUE, scrollX = TRUE, searching = TRUE, ordering = TRUE, dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf'), pageLength = 5, lengthMenu = c(3, 5, 10) )) }) newdattask<- reactive({ req(olddat()) External_Key<- olddat()$Quote.ID Document_Type<- "Activity Task" # Default Subject<- paste(olddat()$Name, olddat()$Quote.ID, sep="_") Status<- "Open" # Default Start_DateTime<- NA Start_DateTime_Time_Zone_Code<- NA #"Central Europe" # Default Due_Date_Time<- NA Due_Date_Time_Time_Zone_Code<- NA #"Central Europe" #Default Planned_Duration<- NA Actual_Duration<- NA Completion_Date_Time<- NA Main_Employee_Responsible_ID<- olddat()$Sales.Rep MainEmployeeResponsiblePartyExternalKey<- NA Main_Account_External_Key<- #olddat()$Account.Number..Customer. paste0("A",olddat()$Account.Number..Customer.) Main_Account_ID<- NA Main_Contact_ID_External_Key<- NA Main_Contact_ID<- NA Processor_ID<- olddat()$Sales.Rep ProcessorPartyExternalKey<- NA Completion_Percent<- NA Category<- NA Priority<- NA Sales_Territory_ID<- NA Sales_Organization_External_Key<- NA Sales_Organization_ID<- NA Distribution_Channel<- NA Division<- NA Data_Origin<- NA Processor_Email<- NA Processor_Name<- NA Last_Changed<- NA df<- data.frame(External_Key, Document_Type, Subject, Status, Start_DateTime, Start_DateTime_Time_Zone_Code, Due_Date_Time, Due_Date_Time_Time_Zone_Code, Planned_Duration, Actual_Duration, Completion_Date_Time, Main_Employee_Responsible_ID, MainEmployeeResponsiblePartyExternalKey, Main_Account_External_Key, Main_Account_ID, Main_Contact_ID_External_Key, Main_Contact_ID, Processor_ID, ProcessorPartyExternalKey, Completion_Percent, Category, Priority, Sales_Territory_ID, Sales_Organization_External_Key, Sales_Organization_ID, Distribution_Channel, Division, Data_Origin, Processor_Email, Processor_Name, Last_Changed) fulldf<- df |> left_join(acc, by=c("Main_Account_External_Key"="Former_CRM_reference")) df<-fulldf |> filter(!is.na(Account_ID)) |> mutate(Main_Account_External_Key=NA) |> select(-Main_Account_ID) |> rename(Main_Account_ID=Account_ID) |> select(External_Key, Document_Type, Subject, Status, Start_DateTime, Start_DateTime_Time_Zone_Code, Due_Date_Time, Due_Date_Time_Time_Zone_Code, Planned_Duration, Actual_Duration, Completion_Date_Time, Main_Employee_Responsible_ID, MainEmployeeResponsiblePartyExternalKey, Main_Account_External_Key, Main_Account_ID, Main_Contact_ID_External_Key, Main_Contact_ID, Processor_ID, ProcessorPartyExternalKey, Completion_Percent, Category, Priority, Sales_Territory_ID, Sales_Organization_External_Key, Sales_Organization_ID, Distribution_Channel, Division, Data_Origin, Processor_Email, Processor_Name, Last_Changed) df.umatched<-fulldf |> filter(is.na(Account_ID)) sel.template.desc <- saptemplate[saptemplate$`Sheet Name` == "Task",] sel.template.desc |> filter(Mandatory == "Yes") |> pull(Header) -> essential.columns #error.mandatory <- NULL error.df <- data.frame( Country = NULL, Name = NULL, Rows = NULL, Expected = NULL ) manerrdt<-NULL for (k in seq_along(essential.columns)) { print("Creating and writing data with missing mandatory values") manerrdt <- rbind(df[is.na(df[, essential.columns[k]]),],manerrdt) if (nrow(manerrdt > 0)) { manerrdt <- manerrdt |> mutate(error = paste0(essential.columns[k], " missing")) } Country <- "AT" Name <- "Task" err.type <- paste0("Missing ", essential.columns[k]) err.count <- nrow(df[is.na(df[, essential.columns[k]]),]) print("Removing rows with empty essential columns") df <- df[!is.na(df[, essential.columns[k]]),] if (err.count > 0) { error.df <- rbind( error.df, data.frame( Country = Country, Name = Name, err.type = err.type, err.count = err.count ) ) #Error cal } } print("Identifying columns associated with codelists") # List of columns that have a codelist codelistcols <- sel.template.desc |> filter(!is.na(`CodeList File Path`)) |> pull(Header) def<-NULL for (k in seq_along(codelistcols)) { print(paste0("Identifying errors ", codelistcols[k])) def.rows <- which(!df[, codelistcols[k]] %in% c(pull(codelist_files[codelistcols[k]][[1]], Description), NA)) def.n <- df[def.rows, 1] def.rows.val <- df[!df[, codelistcols[k]] %in% c(pull(codelist_files[codelistcols[k]][[1]], Description), NA), codelistcols[k]] def.colname <- rep(codelistcols[k], length.out = length(def.rows)) def <- rbind(data.frame(def.rows, def.n, def.rows.val, def.colname),def) err.type <- paste0("Codelist Mismatch ", codelistcols[k]) #Error cal err.count <- nrow(def) #Error cal if (err.count > 0) { error.df <- rbind( error.df, data.frame( Country = Country, Name = Name, err.type = err.type, err.count = err.count ) ) } print(paste0("Removing errors ", codelistcols[k])) # Removes any mismatch df[!df[, codelistcols[k]] %in% c(pull(codelist_files[codelistcols[k]][[1]], Description), NA), codelistcols[k]] <- NA # Matches each column with the corresponding code list and returns the value df[, codelistcols[k]] <- pull(codelist_files[codelistcols[k]][[1]], 2)[match(pull(df, codelistcols[k]), pull(codelist_files[codelistcols[k]][[1]], Description))] } max.length <- as.numeric(sel.template.desc$`Max Length`) dtype <- sel.template.desc$`Data Type` rowval <- NULL ival <- NULL rval <- NULL lenght.issue.df <- NULL # Changing the data class for (k in 1:ncol(df)) { if (dtype[k] == "String") { df[, k] <- as.character(pull(df, k)) } if (dtype[k] == "Boolean") { df[, k] <- as.logical(pull(df, k)) } if (dtype[k] == "DateTime") { df[, k] <- lubridate::ymd(pull(df, k)) } if (dtype[k] == "Time") { df[, k] <- lubridate::hms(pull(df, k)) } # This list will increase and also change based on input date and time formats } # Length Rectification colclasses <- lapply(df, class) print("Rectifying Length") for (k in 1:ncol(df)) { if (colclasses[[k]] == "character") { print("found character column ") rowval <- pull(df, 1) ival <- ifelse(nchar(pull(df, k)) == 0 | is.na(nchar(pull(df, k))), 1, nchar(pull(df, k))) rval <- max.length[k] colval <- pull(df, k) colnm <- colnames(df)[k] cntr <- "AT" # rectifying data length df[, k] <- ifelse(nchar(pull(df, k)) > max.length[k], substring(pull(df, k), 1, max.length[k]), pull(df, k)) } lenght.issue.df <- rbind(lenght.issue.df, data.frame(rowval, ival, rval, colnm, colval, cntr)) err.type <- paste0("Length error ", colnames(df)[k]) # Error cal err.count <- sum(ival > rval, na.rm = T) # Error cal if (err.count > 0) { error.df <- rbind( error.df, data.frame( Country = Country, Name = Name, err.type = err.type, err.count = err.count ) ) #Error cal } } lenght.issue.df <- dplyr::filter(lenght.issue.df, ival > rval) taskdat<-list(dat=df, err=error.df, man.error=manerrdt, code.error=def, length.error=lenght.issue.df, unm.err=df.umatched) return(taskdat) }) newdatnotes<-reactive({ req(newdattask()) # sel.ids<-newdattask()$External_Key # print(sel.ids) External_Key<-paste(olddat()$Name, olddat()$Quote.ID, sep = "_") Task_External_Key<-olddat()$Quote.ID Task_ID<-NA Text<- paste("con",olddat()$Contact, "amt",olddat()$Total.Amount, "ref",olddat()$Customer.Reference, "slt",olddat()$Sales.Taker, "qst" ,olddat()$Quote.Status, "oid",olddat()$Order.ID..Order., "typ",olddat()$Quote.type, "url" ,olddat()$Sharepoint.URL, "mer",olddat()$salerep, sep = "_") Language_Code<-NA Type_Code<- "Body Text" Author_Name<-NA Updated_On<-NA df<- data.frame(External_Key, Task_External_Key, Task_ID, Text, Language_Code, Type_Code, Author_Name, Updated_On) df<- df |> mutate(Text = gsub(",","..",Text)) # df<- df |> # filter(Task_External_Key %in% sel.ids) sel.template.desc <- saptemplate[saptemplate$`Sheet Name` == "Tasks_Notes",] sel.template.desc |> filter(Mandatory == "Yes") |> pull(Header) -> essential.columns error.mandatory <- NULL error.df <- data.frame( Country = NULL, Name = NULL, Rows = NULL, Expected = NULL ) for (k in seq_along(essential.columns)) { print("Creating and writing data with missing mandatory values") manerrdt <- df[is.na(df[, essential.columns[k]]),] if (nrow(manerrdt > 0)) { manerrdt <- manerrdt |> mutate(error = paste0(essential.columns[k], " missing")) } Country <- "AT" Name <- "Task" err.type <- paste0("Missing ", essential.columns[k]) err.count <- nrow(df[is.na(df[, essential.columns[k]]),]) print("Removing rows with empty essential columns") df <- df[!is.na(df[, essential.columns[k]]),] if (err.count > 0) { error.df <- rbind( error.df, data.frame( Country = Country, Name = Name, err.type = err.type, err.count = err.count ) ) #Error cal } } print("Identifying columns associated with codelists") # List of columns that have a codelist codelistcols <- sel.template.desc |> filter(!is.na(`CodeList File Path`)) |> pull(Header) def<-NULL for (k in seq_along(codelistcols)) { print(paste0("Identifying errors ", codelistcols[k])) def.rows <- which(!df[, codelistcols[k]] %in% c(pull(codelist_files[codelistcols[k]][[1]], Description), NA)) def.n <- df[def.rows, 1] def.rows.val <- df[!df[, codelistcols[k]] %in% c(pull(codelist_files[codelistcols[k]][[1]], Description), NA), codelistcols[k]] def.colname <- rep(codelistcols[k], length.out = length(def.rows)) def <- rbind(data.frame(def.rows, def.n, def.rows.val, def.colname),def) err.type <- paste0("Codelist Mismatch ", codelistcols[k]) #Error cal err.count <- nrow(def) #Error cal if (err.count > 0) { error.df <- rbind( error.df, data.frame( Country = Country, Name = Name, err.type = err.type, err.count = err.count ) ) } print(paste0("Removing errors ", codelistcols[k])) # Removes any mismatch df[!df[, codelistcols[k]] %in% c(pull(codelist_files[codelistcols[k]][[1]], Description), NA), codelistcols[k]] <- NA # Matches each column with the corresponding code list and returns the value df[, codelistcols[k]] <- pull(codelist_files[codelistcols[k]][[1]], 2)[match(pull(df, codelistcols[k]), pull(codelist_files[codelistcols[k]][[1]], Description))] } max.length <- as.numeric(sel.template.desc$`Max Length`) dtype <- sel.template.desc$`Data Type` rowval <- NULL ival <- NULL rval <- NULL lenght.issue.df <- NULL # Changing the data class for (k in 1:ncol(df)) { if (dtype[k] == "String") { df[, k] <- as.character(pull(df, k)) } if (dtype[k] == "Boolean") { df[, k] <- as.logical(pull(df, k)) } if (dtype[k] == "DateTime") { df[, k] <- lubridate::ymd(pull(df, k)) } if (dtype[k] == "Time") { df[, k] <- lubridate::hms(pull(df, k)) } # This list will increase and also change based on input date and time formats } # Length Rectification colclasses <- lapply(df, class) print("Rectifying Length") for (k in 1:ncol(df)) { if (colclasses[[k]] == "character") { if(colnames(df)[k]=="Text"){ next } print("found character column ") rowval <- pull(df, 1) ival <- ifelse(nchar(pull(df, k)) == 0 | is.na(nchar(pull(df, k))), 1, nchar(pull(df, k))) print("here") rval <- max.length[k] colval <- pull(df, k) colnm <- colnames(df)[k] cntr <- "AT" # rectifying data length df[, k] <- ifelse(nchar(pull(df, k)) > max.length[k], substring(pull(df, k), 1, max.length[k]), pull(df, k)) } lenght.issue.df <- rbind(lenght.issue.df, data.frame(rowval, ival, rval, colnm, colval, cntr)) err.type <- paste0("Length error ", colnames(df)[k]) # Error cal err.count <- sum(ival > rval, na.rm = T) # Error cal if (err.count > 0) { error.df <- rbind( error.df, data.frame( Country = Country, Name = Name, err.type = err.type, err.count = err.count ) ) #Error cal } } lenght.issue.df <- dplyr::filter(lenght.issue.df, ival > rval) tasknotedat<-list(dat=df, err=error.df, man.error=manerrdt, code.error=def, length.error=lenght.issue.df) return(tasknotedat) }) newatt<-reactive({ # req(newdattask()) # sel.ids<-newdattask()$External_Key TasksExternalKey<- olddat()$Quote.ID #paste0(olddat()$Quote.ID,"_TA01") TaskID<-paste(olddat()$Name, olddat()$Quote.ID, sep = "_") #olddat()$Quote.ID AttachmentTypeCode<- "10051" AttachmentName<- paste0("Att_",olddat()$Quote.ID) FilePath<-NA WebLink<-olddat()$Sharepoint.URL df<-data.frame(TasksExternalKey,TaskID, AttachmentTypeCode, AttachmentName, FilePath, WebLink) # df<- df |> # filter(TasksExternalKey %in% sel.ids) df }) output$task<- renderDataTable({ req(newdattask()) datatable(newdattask()$dat, #extensions = "Buttons", options = list( paging = TRUE, scrollX = TRUE, searching = TRUE, ordering = TRUE, #dom = 'Bfrtip', #buttons = c('copy', 'csv', 'excel', 'pdf'), pageLength = 5, lengthMenu = c(3, 5, 10) )) }) output$taskdl<- downloadHandler( filename = function() { paste("Task-", Sys.Date(), ".csv", sep="") }, content = function(file) { write.csv(newdattask()$dat, file, row.names = FALSE, quote = FALSE, na = "") } ) output$taskerror<- renderDataTable({ req(newdattask()) #req(newdatnotes()) print(newdattask()$error.df) datatable(newdattask()$error.df, extensions = "Buttons", options = list( paging = TRUE, scrollX = TRUE, searching = TRUE, ordering = TRUE, dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf'), pageLength = 5, lengthMenu = c(3, 5, 10) )) }) output$taskerrorman<- renderDataTable({ req(newdattask()) datatable(newdattask()$man.error, extensions = "Buttons", options = list( paging = TRUE, scrollX = TRUE, searching = TRUE, ordering = TRUE, dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf'), pageLength = 5, lengthMenu = c(3, 5, 10) )) }) output$taskerrorcode<- renderDataTable({ req(newdattask()) datatable(newdattask()$code.error, extensions = "Buttons", options = list( paging = TRUE, scrollX = TRUE, searching = TRUE, ordering = TRUE, dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf'), pageLength = 5, lengthMenu = c(3, 5, 10) )) }) output$taskerrorlength<- renderDataTable({ req(newdattask()) datatable(newdattask()$length.error, extensions = "Buttons", options = list( paging = TRUE, scrollX = TRUE, searching = TRUE, ordering = TRUE, dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf'), pageLength = 5, lengthMenu = c(3, 5, 10) )) }) output$taskerrorunmatched<- renderDataTable({ req(newdattask()) datatable(newdattask()$unm.err, extensions = "Buttons", options = list( paging = TRUE, scrollX = TRUE, searching = TRUE, ordering = TRUE, dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf'), pageLength = 5, lengthMenu = c(3, 5, 10) )) }) ### Notes output$notes<- renderDataTable({ datatable(newdatnotes()$dat, #extensions = "Buttons", options = list( paging = TRUE, scrollX = TRUE, searching = TRUE, ordering = TRUE, #dom = 'Bfrtip', #buttons = c('copy', 'csv', 'excel', 'pdf'), pageLength = 5, lengthMenu = c(3, 5, 10) )) }) output$tasknotesdl<- downloadHandler( filename = function() { paste("TaskNotes-", Sys.Date(), ".csv", sep="") }, content = function(file) { write.csv(newdatnotes()$dat, file, row.names = FALSE, quote = FALSE, na = "") } ) output$tasknoteserror<- renderDataTable({ #req(newdattask()) req(newdatnotes()) print(newdatnotes()$error.df) datatable(newdattask()$error.df, extensions = "Buttons", options = list( paging = TRUE, scrollX = TRUE, searching = TRUE, ordering = TRUE, dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf'), pageLength = 5, lengthMenu = c(3, 5, 10) )) }) output$tasknoteserrorman<- renderDataTable({ req(newdatnotes()) datatable(newdatnotes()$man.error, extensions = "Buttons", options = list( paging = TRUE, scrollX = TRUE, searching = TRUE, ordering = TRUE, dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf'), pageLength = 5, lengthMenu = c(3, 5, 10) )) }) output$tasknoteserrorcode<- renderDataTable({ req(newdatnotes()) datatable(newdatnotes()$code.error, extensions = "Buttons", options = list( paging = TRUE, scrollX = TRUE, searching = TRUE, ordering = TRUE, dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf'), pageLength = 5, lengthMenu = c(3, 5, 10) )) }) output$tasknoteserrorlength<- renderDataTable({ req(newdatnotes()) datatable(newdatnotes()$length.error, extensions = "Buttons", options = list( paging = TRUE, scrollX = TRUE, searching = TRUE, ordering = TRUE, dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf'), pageLength = 5, lengthMenu = c(3, 5, 10) )) }) output$taskatt<- renderDataTable({ req(newatt()) datatable(newatt(), #extensions = "Buttons", options = list( paging = TRUE, scrollX = TRUE, searching = TRUE, ordering = TRUE, #dom = 'Bfrtip', #buttons = c('copy', 'csv', 'excel', 'pdf'), pageLength = 5, lengthMenu = c(3, 5, 10) )) }) output$taskattdl<- downloadHandler( filename = function() { paste("manifest", ".csv", sep="") }, content = function(file) { write.csv(newatt(), file, row.names = FALSE, quote = FALSE, na = "") } ) })