Ladvien's Lab

Latest Posts

Working with Dates in SQLdf

Mixing R and SQL is powerful. One of the easiest ways to implement this combination is with the R library SQLdf.

If TL;DR, skip to Coerce Date Types into Strings before Passing to SQLdf at bottom.

SQLdf

The power of SQLdf comes from its ability to convert dataframes into SQLite databases on the fly. To the user, it doesn't appear like anything special is going on, but under the hood R is working together with a SQLite client to create a table which can be queried and manipulated with ANSI SQL calls.

For example,

dataFrame1 <- read.csv(pathToData)
library("sqldf")
dataFrame2 <- sqldf("SELECT FirstName FROM dataFrame")

These three lines do a lot. It loads data from a CSV, loads a library of functions for convert R dataframes into SQLite databases, and then the sqldf() function call does two things at once. It converts the R dataframe into a SQLite database and then queries it for the FirstName column.

If we were to assume the dataFrame1 variable contained data like this:

PersonalID FirstName LastName
B7YIOJIGF9CDP6FV7TANQXLMQRMBTVTB Bob Person
ASGJ4F95HS85N39DJ12AJB094M59DJ45 Jane People

Then the dataFrame2 <- sqldf("SELECT FirstName FROM dataFrame) will create a variable called dataFrame2 which contains the FirstName column from dataFrame1

FirstName
Bob
Jane

And this is how we will shape our data in the R-SQL way.

Datatypes

One of the most important things a human can learn about computers is something called datatypes. When computers process information they need a little help from humans in attempt to understand what to do with the information. For example, what do these numbers mean to you?

76110, 444-325-7645, 10/24/1980

Most humans (at least in the United States) will know the first number is a ZIP code, the second a phone number, and last date. Humans know this because our brains have learned how to discern from context. In the case of the ZIP code, it's exactly 5 numbers, the phone contains dashes at at exact places, and the date contains slashes in the exact spot we'd expect of a date.

Unfortunately, computers have a little more difficulty with this. Most computers are smart enough now days to know the phone number and date of birth, but the ZIP code will confuse the heck out of a computer.

A computer's initial reaction in seeing the ZIP code is, "Oh, you mean 76,110. That's a big number." When really, this number represents a geographic location.

Ok, let's make this more relevant to HMIS work. The way to help a computer understand what numbers are representing is by telling the computer what type of data a particular column is. This is known as a datatype. For us, we really only deal with a few datatypes, but their are hundreds of thousand of datatypes.

In R you can see what datatype a column of your dataframe is by clicking the blue button next to the dataframe name in the Global Environment variables.

We will be dealing with the following:

  • Dates (called "POSXct" in R)
  • Strings (called "chr" in R)
  • Numbers
  • Factors

Of course, every programming language can calls these datatypes by different names, thus, furthering confusion. (I mean, c'mon, programming is simple enough as it is--we've got to make it a little challenging.)

Dates

Date datatypes usually look like this:

10/24/1980

But it can come in many different formats. It's probably best to differentiate between datatype and data format . A data type describes how the information should be used--it's important for a computer. Data format describes how a computer should display information to the human--therefore, it's useful for a human.

An example of different formats of the same data:

10/24/1980
1980-10-24
102480

Ok, back to the date datatype. It is used when dealing with dates. By declaring a variable as having a date datatype, it is telling the computer whatever we put into that variable to interpret as a date. Simple enough.

Strings

When we talk about string we aren't talking about fuzzy things kittens chase. A string datatype is a series of characters (one part of a string) strung together. Anything can be a string. They are probably the most important datatype, since they can tell a computer to look at a number and see something else. Confused? Let's look at some examples.

We tell a computer data is a string is by putting it in double quotes "this is a string" or single quotes 'this is also a string' .

Here's an example of assigning a string in R:

myFirstString <- "this is a string"

Great! But what can we do with it? Well, a lot.

Let's say we wanted to pass a path of a file to a read.csv() function. We could do so by providing the path as a string.

dataFrame <- read.csv("/Users/user/Downloads/Client.csv")

The above will load the Client.csv file located at the /Users/user/Downloads/ directory--the computer knows how to read the path because it's a string.

But why are strings so important? Well, they allow us to tell a computer to override its basic instinct and view a piece of data as something other than what the computer would guess it is.

Returning to the ZIP code.

notAZipCode <- 76110
myZipCode <- "76110"

These variable assignments may seem to be exactly the same, however, the first one creates a variable as a number, but the second tells the computer, "This is a not a number, it is something else--please don't pretend to understand it. I'll tell you exactly what to do with it later."

Numbers

Number datatypes are easy. It's pretty much how a computer tries to look at all data you provide it. One important characteristic about numbers, you can have the computer perform math functions on numbers, which you couldn't on strings.

dataframe1 <- 12 * 12 
datafram2 <- "12" * "12"

Above, dataframe1 will contain 144 after being executed. But if the second line is attempted to be executed the computer will freak out, "This is a string! I can't add strings! You told me you'd tell me what to do with them..."

Factors

Factors are a special datatype in R. Most of all the variables we load in R will start out as factors. Essentially, factors are categories of data.

Red,
Orange,
Green,
Blue,
Indigo,
Violet

Is an example of factors. They are categories of data. The important of factors will become more evident as we work through these tutorials in R.

If you don't understand factors, it's cool. Just think of them as strings. However, if you don't understand strings, please ask any questions in comments below. Understanding them is critical to working with SQLdf.

SQLdf and Datatypes

Anytime you mix two different languages it pays to be careful about meaning. As I learned once by talking about pie as something I liked--come to find out, it was funny to Hispanic friends who were learning English. (Apparently pie is Spanish for foot?)

When mixing R and SQL we must be careful about how the two languages look at the datatypes. In R it sees dates as a POSXct datatype (this is essentially fancy date datatype. Would you like to know more ?)

Well, this is all fine and dandy, but when we pass commands from R to SQL it is all passed as a string.

dataFrame2 <- sqldf("SELECT * FROM dataFrame1")

Notice SELECT * FROM dataFrame1 is all in quotation marks? This turns it into a string then it passes it SQLite, which is hidden to us.

If all this is a bit overwhelming, no worries. Bookmark this page to refer back to later. Just remember the following:

Date columns must be converted into a chr datatype before passing it to SQL. How to we convert datatypes? It's pretty darn simple. We use something called data coercion.

Coercing Data Types

Let's go back to that ZIP code and number example. Let's say the computer reads all your ZIP codes from a file as a number. This happens a lot, since to the computer that's what it looks like--so it guesses that's what you are going to want.

But no, we want those ZIP codes to be strings. To do this, we can get a particular column from a dataframe by writing the name of the dataframe then $ then the name of the column. For example, datafram$zipCodes will return only the column zipCodes from dataframe.

Alright, now we have a way to select one column from our dataframe we can attempt to convert that one column's datatype. To do this use the as.character() command.

dataframe$zipCodes <- as.character(dataFrame$zipCodes)

This will convert the zipCode column from a number into a string, then, it assigns it back to the column zipCodes. Boom! We've told the computer to stop trying to make a ZIP code a number. Instead, treat it as a string. And with that, we will tell the computer later how to use ZIP codes.

Coerce Date Types into Strings before Passing to SQLdf

Ok, now for the reason for this entire article. Before passing any dates to SQLdf we need to first convert them to strings. Otherwise, SQLdf will try to treat them as numbers--which will cause a lot of heartache.

For example, a Client.csv file should have a DateCreated column. This represents the date a case-manager put the data into HMIS. The data should look something like this:

... DateCreated DateUpdated
... 10/23/14 0:01 4/23/15 15:27
... 5/22/13 9:23 10/15/16 1:29
... 6/3/15 19:22 3/17/17 21:09

Let's try to get all of the clients who've been entered after 10/01/2014.

dataFramContainingDates <- read.csv("/Users/user/Downloads/Client.csv")
datesEntered <- sqldf("SELECT * FROM dataFramContainingDates WHERE DateCreated > '2014-10-01'")

The above code should provide every column where DateCreated date is greater than 2014-10-01. But, instead, it will result in an empty dataframe. Waaah-waah.

Essentially, this is because SQL is comparing a number and a string. It freaks the computer out.

Instead, we should convert the DateCreated column to a string instead of a date. Then, SQL will actually convert it from a string to a date.

Confused? Imagine me when I was trying to figure this out on my own.

Ok, so, the take away? Before passing any dates to SQL convert them to strings.

dataFramContainingDates <- read.csv("/Users/user/Downloads/Client.csv")
dataFrameContaingDates$DateCreated <- as.character(dataFrameContaingDates$DateCreated)
datesEntered <- sqldf("SELECT * FROM dataFramContainingDates WHERE DateCreated > '2014-10-01'")

By using the as.character function to convert the DateCreated column to a string and then assigning it back to the dateframe, it sets SQL up to do the date comparisons correctly. Using the dateframe from above, this should result in the following table:

... DateCreated DateUpdated
... 10/23/14 0:01 4/23/15 15:27
... 6/3/15 19:22 3/17/17 21:09

Confused as heck? Feel free to ask questions in the comments below!

Creating a List of Domestic Violence Victims

In this first work challenge you will use R and SQL to get a by-name-list of those who are domestic violence victims from an HMIS data pull (5.1).

Data Needed

The HMIS Data Pulls are simply a relational database which are broken into multiple CSVs. These CSVs will change in formatting, as stipulated by HUD. The current version of these CSVs is 5.1. For this work challenge the focus will be on two CSVs.

  1. Client.csv
  2. HealthAndDV.csv

The Client file will contain one row per client and only one row. Each row will contain most of all the Client's demographic information.

The HealthAndDV file will contain a row for every HUD Entry Assessment completed on the participant. Each entry will contain general health information as well the client's domestic violence information, which the client reported during the HUD Entry Assessment.

What ties the two files together is the PersonalID column. This ID is meant to be the grand-mamma of all client IDs. It is 32 characters long and contain both numbers and letter:

B7YIOJIGF9CDP6FV7TANQXLMQRMBTVTB

(note, this ID is called the "Enterprise ID" in our HMIS software)

Both the Client and HealthAndDV contain the PersonalID column. This often referred to as a key when dealing with relational databases. This unique ID in both files will allow us to merge the two data sets together using something called joins .

Now, in the Client.csv the information is readable to us humans. There will be the FirstName , LastName , SSN columns and many more. But in the HealthAndDV.csv the information is trickier. For this challenge we are going to focus on one column DomesticViolenceVictim . When you open the data set you may notice that instead of "Yes" or "No" answers in the columns you will see "1" or "0". That's because computers understand the 1 and 0 much quicker than Yes or No.

This is an important side note for managing data. Make the databases easy for computers to understand and report generation will be much faster. You have to think, if using a 1 instead of Yes could save 0.5 seconds on a calculation, then when you have a dataset which contains 1000 records you just saved 500 seconds 8.3 seconds. Now, multiply by 1,700,000 records. Well, you get the picture.

Ok. Back to the problem at hand. Just know "1" is equal to "Yes" and "0" is equal to "No". So, for this challenge, we will want to find all the clients who have a "1" in the DomesticViolenceVictim column

The Goal

We are going to merge the two data sets and to discover the following:

  1. A list of clients who are victims of domestic violence.
  2. A count of how many clients are fleeing domestic violence.

Really, the second piece of information is counting how many people are in the list of those who are victims.

To get this information we will need to do the following:

  1. Load the Client.csv and HealthAnd.csv
  2. Filter the HealthAndDV dataset to the most recent according to the column DateCreated
  3. Join (merge) the dataframes where their PersonalID are the same
  4. Filter the merged dataframe to those who've reported 1 in DomesticViolenceVictim
  5. Write this data to a file.
  6. Use a function to count how many participants are in this victim list.

The Resources

Below are the resources which should help you understand each step of the process.

Step 1

  • R Programming A-Z -- Video 41 -- Loading and Importing Data in R
  • R Programming A-Z -- Video 21 -- Functions in R

Step 2

Step 3

  • The Complete SQL Bootcamp -- All Videos in Section 8

Step 4 --

Step 5 --

Step 6 --

  • The Complete SQL Bootcamp -- All Videos in Section 5
  • The Complete SQL Bootcamp -- All Videos in Section 6

The R and SQL Way

Below is my attempt to describe the method I use to get at HMIS data. In short, I'm mixing two powerful data languages to get answers from a data set quickly.

What is SQL?

SQL stands for Structured Query Language. Which can be translated as, "Asking a question a computer could understand." This computer language was designed to get data off a remote relational database .

A sample of what SQL looks like:

SELECT Data FROM DataSet WHERE Data='BlueEyes'

SQL Pros:

  • Easy to understand
  • Can be learned quickly
  • Powerful in merging data sets

SQL Cons: * No advanced functions * Does not allow for additional features to be added by users

Would you like to know more?

What is R?

R is a programming language for super nerds. Often, it is used by those working in:

  • Bio-statistic (genetic sequencing)
  • High-level economics
  • Big-data (think all data collected by Facebook)
  • Machine learning

It is extremely fast computationally. The people who designed it wanted something which could crunch big data sets, on their computer, in a matter of minutes.

One of the neatest parts of R is it allows for user written plugins. Want to translate a data set of ZIP codes into their corresponding GPS coordinateds. Their's a plugin for that! And did I mention it's all free!

Would you like to know more?

Mix R and SQL? But why...

Think of our approach to data as Spanglish. We are going to take two major programming languages to get the best of both. When we don't have the exact word to describe something, we will switch to a different language and use its vocabulary.

R is a powerful tool, but often, the syntax is boggish. It is hard to read and figure out what’s going on. SQL on the other hand, it’s pretty simple. And humans have an easier time reading it.

Personally, I'm looking to solve problems as quickly as possible and I’ve found by mixing the two I get to solutions quick. If I'm having a hard time getting Google to tell me how to do something in SQL, I'll switch and see if Google know's how to do it in R. Thus, getting to what I need do much quicker. And let's not fool ourselves--learning a programming language is learning how to Google well.

A second reason to mix SQL is about respect and marketability. R seems to be gaining ground in a lot of data sciences, and seems to be the tool when it comes to economics and statistics, however, most data exchanges have SQL at their heart. Therefore, when I can use my work as an excuse to develop a marketable skill, I’m going to do it.

A third reason to mix the two, most often the servers where our data calculations are being done are extremely limited in their hardware. This results in calculations taking much longer on a server than they would on or personal PC. For example, a query which would take 45 minutes on our HMIS software vendor's server takes around 30 seconds on my personal PC.

A fourth reason, by completing our calculations on our personal computers it reduces the number of times client level information would need to be transmitted back-and-forth from the server. Of course, this doesn't mean the data is more secure, it simply means the opportunities for more secure data are in our hands. This method makes follow proper PC security practices much more important (encrypting hard-drives, not sharing passwords, etc) Localization of data.

Bluetooth Low Energy in JavaScript

For a long time now I've put off learning JavaScript. It really never interested me. I'd like to say it was the thought, "Oh, JavaScript is for web developers and I'm embedded all the way!" But that wasn't really it. I think it hasn't appealed to me because I couldn't connect it to hardware. Well, at least, that was my assumption.

However, I've recently discovered Google's Web APIs. Specifically, their Bluetooth Low Energy API.

It's pretty amazing. It allows a developer to write asynchronous JavaScript using Promises to get into the hardware of the client's PC, all from the browser!

Now, this might sound like it open for security issues--and perhaps it will be. But there are two requirements Google has put in place which hopefully gets around any issues. First, the API can only be called by action. Secondly, the API can only be called from a secured connection (HTTP over SSL).

Ok, there are few other downers to talk about. First this only works in Chrome--but given this is a Google API, well, duh . The other is not all OSes are currently supported. The following I've tested and work right out of the box:

  • Mac OS
  • Android

The others which are supposed to be supported but I've not tested:

  • Linux
  • Windows (with some work)
  • Chromium

Having worked with Bluetooth LE on all of these OSes I can say there is hope for Windows. In fact, I think with the Creator's Update the Microsoft folk opened up the last needed ingredient . The real hold out will be iOS. Apple is not a fan of browser apps. They would much rather browsing be done inside their native apps. If I'm being positive, I'd say this is so Apple can make sure the mobile UX is excellent, and by forcing native apps, they have control by app approval. If I'm being negative, well, Apple takes 30% on app purchases and web apps land them nada. Just my opinion.

If you'd like to stay up to date on compatibility of BLE in the browser there is a an implementation status page on the Web Bluetooth Community Group:

Sadly, right now iOS is the loser.

Moving into the fun part. Below is how to kick things off.

To begin, it will pay to keep the Mozilla Developer Netowork's Web Bluetooth API open for reference.

The documentation is actually pretty robust--and with this guide, the process of subscribing to a device characteristic should be pretty straight forward.

The first piece we need are service IDs to search for.

let optionalServices = document.getElementById('optionalServices').value
    .split(/, ?/).map(s => s.startsWith('0x') ? parseInt(s) : s)
    .filter(s => s && BluetoothUUID.getService);

This takes the text element of the DOM element 'optionalServices', which should be in the in 16 bit hex format, 0x0000. This becomes one of the service IDs searched in the Bluetooth LE search cycle. For the Bluetooth module HM-10, HM-11, HM-16, HM-17 the service ID is 0xFFE0.

Moving on to the search, when the code below is executed the Chrome browser should show a search and pair menu (see image) for pairing a device. When a device has been paired the promise will resolve returning the device which has been paired.

navigator.bluetooth.requestDevice({
        acceptAllDevices: true,
        optionalServices: optionalServices
    })

It is important to note this block must be called by a user action. For example, if set to execute on page load it will refuse to fire. But if called onClick then it will show. This is meant to provide more security to the API.

As stated, the requestDevice will return a device. Using the promise .then we can begin working with the BluetoothDevice

Which is returned after it has been paired by the user. The BluetoothDevice object has three items of interest.

  • name -- which provides the string name of the device
  • id -- the ID string
  • gatt -- a gatt which contains a reference to the BluetoothRemoteGATTServer object

The BluetoothRemoteGATTServer interface contains many of the methods needed to interact with the Bluetooth device. For example,

device.gatt.connect()

Attempts to asynchronously create a connection with the device through a Promise. If .then is attached then the method will return a service object if succesful. If you are just looking to get something done with Bluetooth, feel free to keep hacking through this article (that's what I'd do--TL;DR). However, if you want to know more about Bluetooth 4 protocol here a few useful links:

Back to the code.

.then(device => {
    pairedDevices[device.name] = device;
    return device.gatt.connect();
}).then

Once the connection attempt has been made and returned succesful, the BluetoothRemoteGATTServer object returned can be petitioned for a list of services.

....
    return device.gatt.connect();
})
.then(server => {
    return server.getPrimaryServices();
})

This will fire asynchronously using promises, and if succesful, return a BluetoothRemoteGATTService object. This represents all the services the device has public. Then, the returned service object may be iterated over to identify get characteristics of the device. (Almost to the data, I swear).

....
return server.getPrimaryServices();
    })
    .then(services => {
    services.forEach(service => {

Essentially, the BluetoothRemoteGATTService object is merely an array containing on the services. Using a services.forEach we get each individual service to explore its characteristics.

Now, I'm going to add the whole block which is responsible for iterating over each service and its characteristics, essentially turning on notifications for each device. This will ultimately allow a callback to be fired every every time the device sends data and a reference to a method by which data can be written to the device.

    ....
        let queue = Promise.resolve();
        queue = queue.then(_ => service.getCharacteristics()
            .then(characteristics => {
                characteristics.forEach(characteristic => {
                    writeCharacteristic = characteristic;
                    writeCharacteristic.startNotifications();
                    resolve();
            }); // End enumerating characteristics
        })); // End queue
    }) // End enumerating services
}) // End Service exploration  

The queue is a promise which allows us to loop through services and characteristics without breaking asynchronousity. Since this is my first JavaScript program, I will not try to explain it, but here's another guy's article which attempts to explain it:

Essentially, each service and characteristic contained in the service enumerated. At each characteristic there are two calls. One is to get a reference to the characteristic for writing. This is the global variable writeCharacteristic . Then, notifications for the writeCharacteristic are started. This will assure any time data is made available on the remote device our program is notified.

Now, it should be noted, this above code is hackish. For example, what if there are multiple characteristics and the last one isn't the one we want to know about. Well, we'd have a write reference to the wrong characteristic. So, filtering to the desired characteritic is on my TODO list.

But, let's finish before refactoring.

Let's take a look at how to write data to the device after getting a reference to the desired characteristic.

var write = function (data, string = true) {
    p = new Promise(function (resolve, reject) {
        // See if the device is paired.
        if (pairedDevices) {
            // Has a write reference been discovered.
            if (writeCharacteristic != null) {
                // Don't double encode.
                if (string) {
                    let encoder = new TextEncoder('utf-8');
                    writeCharacteristic.writeValue(encoder.encode(data));
                } else {
                    dataInUint8 = Uint8Array.from(data);
                    writeCharacteristic.writeValue(dataInUint8);
                }
                resolve();

            } else {
                reject("No write characteristic")
            }
        } else {
            reject("No devices paired.")
        }
    }).catch(error => {
    });
    return p;
}

The above method creates a promise and writes to the device asynchoronously. On the way, it checks to make sure the device is paired (not connected, that's on the TODO list). Also, it makes sure we still have a reference to the writeCharacteristic. Then, it will either encode it in utf-8 and write the data, or if the string argument is false it'll just write the data. After it has written the data, the resolve is executed. This would allow the writeMethod to be called like so:

write("Buggers", true).then(_ => {
    // Do something after write has completed.
})

Ok, last bit. Let's setup capturing incoming data. To begin, I created a method which holds a list of all the callback methods to call when data has been received.

var onReceivedDataCallbacks = [];
...
// Adds a function called when a BLE characteristic changes value.
// Mutiple callbacks may be added.
this.addReceivedDataCallback = function (callback) {
    if (writeCharacteristic) {
        writeCharacteristic.addEventListener('characteristicvaluechanged', callback);
        onReceivedDataCallbacks.push({
            key: callback.name,
            value: callback
        })
    }
}

This method allows a method's name to be passed in. It then adds an event listener to this method, which will be called whenever characteristicvaluechanged. Also, it saves this method's name in an array in case I want to stop notifications later (again, not completed, but on the TODO).

The purpose of allowing multiple callbacks is for when I'm working with many modules which all would like to know what's going on with the Bluetooth LE device.

For example, this module is meant to be a piece of a larger project, which is an uploader app using BLE to upload HEX files to AVRs running TinySafeBoot.

Ok, one last piece. Let us see what the onRecievedData callback could looks like:

this.onReceivedData = function (event) {
    // TODO: Handle received data better.  
    // NOTE: the TX buffer for the HM-1X is only 20 bytes.  
    // But other devices differ.
    var receivedData = new Uint8Array(event.target.value.byteLength);
    for (var i = 0; i < event.target.value.byteLength; i++) {
        receivedData[i] = event.target.value.getUint8(i);
    }
}

This is how I've written the notification of data callback. The event.target.value contains the data, which is in an untyped array. I choice to encode it into Uint8 as I'll be working with both ASCII and non-ASCII data.

Well, that's it. This code will allow one to search, connect, write data to, and receive data from Bluetooth Low Energy devices from Chrome browser. Let me know if you have any recommendations.

Here is the full code referenced directly from my project:

Stitching Together HMIS Exports

This is an R script which will take two sets of HMIS 5.1 CSVs and produce a combined set.

A few notes:

  1. A new ExportID will need to be provided.
  2. Each files are deduplicated based upon the Primary Key (ProjectEntryID, PersonalID, etc.)
  3. The Project.csv contains a PITCount which is different based upon the date ranges the two data sets were pulled.  However, the script takes the maximum of the two PITCounts.
  4. It requires HMIS_Functions and dplyr.
    library(dplyr)
    # hmisFunctions <- "/Users/user//Dropbox/HMIS/HMIS_R_Functions/HMIS_R_Functions.R"
    # dataPathOne <- "/Users/user//Dropbox/HMIS/R HMIS CSV Set Merger/HMIS Data 10-01-2016 to 10-31-2016"
    # dataPathTwo <- "/Users/user//Dropbox/HMIS/R HMIS CSV Set Merger/HMIS Data 11-01-2016 to 11-30-2016"
    # pathForCombinedData <- "/Users/user//Dropbox/HMIS/R HMIS CSV Set Merger/"
    # nameOfMergedDirectory <- "Merged"

    hmisFunctions <- "/Users/user/Dropbox/HMIS/HMIS_R_Functions/HMIS_R_Functions.R"
    dataPathOne <- "/Users/user/Dropbox/HMIS/R HMIS CSV Set Merger/HMIS Data 10-01-2016 to 10-31-2016"
    dataPathTwo <- "/Users/user/Dropbox/HMIS/R HMIS CSV Set Merger/HMIS Data 11-01-2016 to 11-30-2016"
    pathForCombinedData <- "/Users/user/Dropbox/HMIS/R HMIS CSV Set Merger/Merged/"
    nameOfMergedDirectory <- "Merged"

    newExportID <- "12345"

    source(hmisFunctions)

    dir.create(file.path(pathForCombinedData, nameOfMergedDirectory), showWarnings = FALSE)
    setwd(file.path(pathForCombinedData, nameOfMergedDirectory))

    ##################################
    # Merge Functions                #
    ##################################
    mergeHmisCsvsWithUniqueIDAndExport <- function(df1, df2, uniqueIDHeader, exportID){
      # Merge the data
      mergedDf <- rbind(df1, df2)
      mergedDf[,uniqueIDHeader] <- as.factor(mergedDf[,uniqueIDHeader])
      # Drop columns which would resist removing duplicates
      drops <- c(uniqueIDHeader, "ExportID")
      mergedDf <- mergedDf[ , !(names(mergedDf) %in% drops)]
      # Get only unique records
      mergedDf <- unique(mergedDf)
      # Creat a PrimaryKey vector.
      xName <- rownames(mergedDf)
      # Add Primary Key back.
      mergedDf <- cbind(xName=xName, mergedDf)
      # Create an ExportID vector.
      exportIDVector <- rep(exportID,length(mergedDf$xName))
      # Add ExportID vector back.
      mergedDf <- cbind(mergedDf, exportIDVector)
      # Rename newly created PrimaryKey and ExportID appropriately.
      colnames(mergedDf)[ncol(mergedDf)] <- "ExportID"
      colnames(mergedDf)[1] <- uniqueIDHeader
      mergedDf
    }

    mergeHmisCsvsWithExportAndPrimaryKey <- function(df1, df2, primaryKey, exportID){
      # Merge the data
      mergedDf <- rbind(df1, df2)

      # Drop columns which would resist removing duplicates
      drops <- c("ExportID")
      mergedDf <- mergedDf[ , !(names(mergedDf) %in% drops)]

      # Get only unique records
      #mergedDf <- unique(mergedDf, incomparables = FALSE)
      mergedDf <- mergedDf[!duplicated(mergedDf[,c(primaryKey)]),]
      # Create an ExportID vector.
      exportIDVector <- rep(exportID,length(mergedDf[1]))
      # Add ExportID vector back.
      mergedDf <- cbind(mergedDf, exportIDVector)
      # Rename newly created PrimaryKey and ExportID appropriately.
      colnames(mergedDf)[ncol(mergedDf)] <- "ExportID"
      mergedDf
    }

    mergeHmisCsvsWithExportId <- function(df1, df2, exportID){
      # Merge the data
      mergedDf <- rbind(df1, df2)
      # Drop columns which would resist removing duplicates
      drops <- c("ExportID")
      mergedDf <- unique(mergedDf[ , !(names(mergedDf) %in% drops)])
      # Create an ExportID vector.
      exportIDVector <- rep(exportID,length(mergedDf[1]))
      # Add ExportID vector back.
      mergedDf <- cbind(mergedDf, exportIDVector)
      # Rename newly created PrimaryKey and ExportID appropriately.
      colnames(mergedDf)[ncol(mergedDf)] <- "ExportID"
      mergedDf
    }

    #####################
    # Merge Affiliation #
    #####################
    affiliationOne <- loadAffiliation(dataPathOne)
    affiliationTwo <- loadAffiliation(dataPathTwo)
    affiliationCombined <- rbind(affiliationOne, affiliationTwo)
    affiliationCombined <- unique(affiliationCombined)
    remove(list=c("affiliationOne", "affiliationTwo"))

    #####################
    # Merge Client      #
    #####################
    clientOne <- loadClient(dataPathOne)
    clientTwo <- loadClient(dataPathTwo)
    clientCombined <- rbind(clientOne, clientTwo)
    clientCombined <- unique(clientCombined)
    remove(list=c("clientOne", "clientTwo"))

    ######################
    # Merge Disabilities #
    ######################
    disabilitiesOne <- loadDisabilities(dataPathOne)
    disabilitiesTwo <- loadDisabilities(dataPathTwo)
    disabilitiesCombined <- mergeHmisCsvsWithUniqueIDAndExport(disabilitiesOne, disabilitiesTwo, "DisabilitiesID", newExportID)
    remove(list=c("disabilitiesOne", "disabilitiesTwo"))

    ##################################
    # Merge Employment and Education #
    ##################################
    employmentEducationOne <- loadEmployementEducation(dataPathOne)
    employmentEducationTwo <- loadEmployementEducation(dataPathTwo)
    employmentEducationCombined <- mergeHmisCsvsWithUniqueIDAndExport(employmentEducationOne, employmentEducationTwo, "EmploymentEducationID", newExportID)
    remove(list=c("employmentEducationOne", "employmentEducationTwo"))

    #####################
    # Merge Enrollment  #
    #####################
    enrollmentOne <- loadEnrollment(dataPathOne)
    enrollmentTwo <- loadEnrollment(dataPathTwo)
    enrollmentCombined <- mergeHmisCsvsWithExportAndPrimaryKey(enrollmentOne, enrollmentTwo, "ProjectEntryID", newExportID)
    remove(list=c("enrollmentOne", "enrollmentTwo"))

    #######################
    # Merge EnrollmentCoC #
    #######################
    enrollmentCocOne <- loadEnrollmentCoc(dataPathOne)
    enrollmentCocTwo <- loadEnrollmentCoc(dataPathTwo)
    enrollmentCocCombined <- mergeHmisCsvsWithUniqueIDAndExport(enrollmentCocOne,
                                                                enrollmentCocTwo,
                                                                "EnrollmentCoCID",
                                                                newExportID)
    remove(list=c("enrollmentCocOne", "enrollmentCocTwo"))

    #####################
    # Merge Exit        #
    #####################
    exitOne <- loadExit(dataPathOne)
    exitTwo <- loadExit(dataPathTwo)
    exitCombined <- mergeHmisCsvsWithExportAndPrimaryKey(exitOne,
                                                         exitTwo,
                                                         "ExitID",
                                                         newExportID)
    remove(list=c("exitOne", "exitTwo"))

    #####################
    # Merge Expot       #
    #####################
    exportOne <- loadExport(dataPathOne)
    exportTwo <- loadExport(dataPathTwo)
    exportCombined <- exportTwo
    remove(list=c("exportOne", "exportTwo"))

    #####################
    # Merge Funder      #
    #####################
    funderOne <- loadFunder(dataPathOne)
    funderTwo <- loadFunder(dataPathTwo)
    funderCombined <- mergeHmisCsvsWithExportId(funderOne, funderTwo, newExportID)
    remove(list=c("funderOne", "funderTwo"))

    #####################
    # Merge Health & DV #
    #####################
    healthAndDVOne <- loadHealthAndDv(dataPathOne)
    healthAndDVTwo <- loadHealthAndDv(dataPathTwo)
    healthAndDVCombined <- mergeHmisCsvsWithUniqueIDAndExport(healthAndDVOne, healthAndDVTwo, "HealthAndDVID", newExportID)
    remove(list=c("healthAndDVOne", "healthAndDVTwo"))

    #############################
    # Merge Income and Benefits #
    #############################
    incomeBenefitsOne <- loadIncomeBenefits(dataPathOne)
    incomeBenefitsTwo <- loadIncomeBenefits(dataPathTwo)
    incomeBenefitsCombined <- mergeHmisCsvsWithUniqueIDAndExport(incomeBenefitsOne,
                                                                 incomeBenefitsTwo,
                                                                 "IncomeBenefitsID",
                                                                 newExportID)
    remove(list=c("incomeBenefitsOne", "incomeBenefitsTwo"))

    #####################
    # Merge Inventory   #
    #####################
    inventoryOne <- loadInventory(dataPathOne)
    inventoryTwo <- loadInventory(dataPathTwo)
    inventoryCombined <- mergeHmisCsvsWithUniqueIDAndExport(inventoryOne, inventoryTwo,
                                                            "InventoryID",
                                                            newExportID)
    remove(list=c("inventoryOne", "inventoryTwo"))

    ######################
    # Merge Organization #
    ######################
    organizationOne <- loadOrganization(dataPathOne)
    organizationTwo <- loadOrganization(dataPathTwo)
    organizationCombined <- mergeHmisCsvsWithExportId(organizationOne, organizationTwo, newExportID)
    remove(list=c("organizationOne", "organizationTwo"))

    #####################
    # Merge Project     #
    #####################
    projectOne <- loadProject(dataPathOne)
    projectTwo <- loadProject(dataPathTwo)
    projectsCombined <- rbind(projectOne, projectTwo)
    # Get only the highest PIT Count
    projectsCombined <- projectsCombined %>% 
      group_by(ProjectID) %>% 
      filter(PITCount==max(PITCount))
    # Remove ExportID column for flattening
    drops <- c("ExportID")
    projectsCombined <- projectsCombined[ , !(names(projectsCombined) %in% drops)]
    projectsCombined <- unique(projectsCombined)
    # Create an ExportID vector.
    exportIDVector <- rep(newExportID,length(projectsCombined$ProjectID))
    # Add ExportID vector back.
    projectsCombined <- as.data.frame(projectsCombined)
    projectsCombined <- cbind(projectsCombined, exportIDVector)
    colnames(projectsCombined)[ncol(projectsCombined)] <- "ExportID"
    remove(list=c("projectOne", "projectTwo"))

    #####################
    # Merge Project CoC #
    #####################
    projectsCoCOne <- loadProjectCoc(dataPathOne)
    projectsCoCTwo <- loadProjectCoc(dataPathTwo)
    projectCoCCombined <- rbind(projectsCoCOne, projectsCoCTwo)
    # Get only the highest PIT Count
    projectCoCCombined <- projectCoCCombined %>% 
      group_by(ProjectID) %>% 
      filter(PITCount==max(PITCount))
    # Remove ExportID column for flattening
    drops <- c("ExportID")
    projectCoCCombined <- projectCoCCombined[ , !(names(projectCoCCombined) %in% drops)]
    projectCoCCombined <- unique(projectCoCCombined)
    # Create an ExportID vector.
    exportIDVector <- rep(newExportID,length(projectCoCCombined$ProjectID))
    # Add ExportID vector back.
    projectCoCCombined <- as.data.frame(projectCoCCombined)
    projectCoCCombined <- cbind(projectCoCCombined, exportIDVector)
    colnames(projectCoCCombined)[ncol(projectCoCCombined)] <- "ExportID"
    remove(list=c("projectsCoCOne", "projectsCoCTwo"))

    #####################
    # Merge Services    #
    #####################
    servicesOne <- loadServices(dataPathOne)
    servicesTwo <- loadServices(dataPathTwo)
    servicesCombined <- mergeHmisCsvsWithUniqueIDAndExport(servicesOne, servicesTwo, "ServicesID", newExportID)
    remove(list=c("servicesOne", "servicesTwo"))

    #####################
    # Merge Site        #
    #####################
    siteOne <- loadSite(dataPathOne)
    siteTwo <- loadSite(dataPathTwo)
    siteCombined <- mergeHmisCsvsWithExportId(siteOne, siteTwo, newExportID)
    remove(list=c("siteOne", "siteTwo"))

    ############################
    # Write combined HMIS CSVs #
    ############################

    write.csv(affiliationCombined, file = paste(pathForCombinedData, "Affiliation.csv", sep=""), na = "", row.names = FALSE)
    write.csv(clientCombined, file = paste(pathForCombinedData, "Client.csv", sep=""), na = "", row.names = FALSE)
    write.csv(disabilitiesCombined, file = paste(pathForCombinedData, "Disabilities.csv", sep=""), na = "", row.names = FALSE)
    write.csv(employmentEducationCombined, file = paste(pathForCombinedData, "EmploymentEducation.csv", sep=""), na = "", row.names = FALSE)
    write.csv(enrollmentCombined, file = paste(pathForCombinedData, "Enrollment.csv", sep=""), na = "", row.names = FALSE)
    write.csv(enrollmentCocCombined, file = paste(pathForCombinedData, "EnrollmentCoC.csv", sep=""), na = "", row.names = FALSE)
    write.csv(exitCombined, file = paste(pathForCombinedData, "Exit.csv", sep=""), na = "", row.names = FALSE)
    write.csv(exportCombined, file = paste(pathForCombinedData, "Export.csv", sep=""), na = "", row.names = FALSE)
    write.csv(funderCombined, file = paste(pathForCombinedData, "Funder.csv", sep=""), na = "", row.names = FALSE)
    write.csv(healthAndDVCombined, file = paste(pathForCombinedData, "HealthAndDV.csv", sep=""), na = "", row.names = FALSE)
    write.csv(incomeBenefitsCombined, file = paste(pathForCombinedData, "IncomeBenefits.csv", sep=""), na = "", row.names = FALSE)
    write.csv(inventoryCombined, file = paste(pathForCombinedData, "Inventory.csv", sep=""), na = "", row.names = FALSE)
    write.csv(organizationCombined, file = paste(pathForCombinedData, "Organization.csv", sep=""), na = "", row.names = FALSE)
    write.csv(projectsCombined, file = paste(pathForCombinedData, "Project.csv", sep=""), na = "", row.names = FALSE)
    write.csv(projectCoCCombined, file = paste(pathForCombinedData, "ProjectCoC.csv", sep=""), na = "", row.names = FALSE)
    write.csv(servicesCombined, file = paste(pathForCombinedData, "Services.csv", sep=""), na = "", row.names = FALSE)
    write.csv(siteCombined, file = paste(pathForCombinedData, "Site.csv", sep=""), na = "", row.names = FALSE)
Lumi4 -- MVVM

One of the issues I've had in the past with the Lumi projects is manageable UI.  The project will start out pretty straight foward, but soon, I'm switching between device types, checking if hardware is ready, and routing callbacks based upon the device selected.  It becomes spaghetti code quick.  On Lumi4, I've decided to bite the bullet and implement MVVM .

After about 20 hours struggling with setting up Lumi4 as an MVVM project I've dervied two conclusions:

  1. It's possible
  2. Apple spoils developers with MVC baked into Xcode

MVVM in C# and UWP isn't simple.  It seems like there is a lot more boiler-plate coding necessary for MVVM than MVC in Xcode.  Eventually, I broke down and downloaded the NuGet package Prism , as a MVVM helper.  This helped alleviate some of the code necesssary for Commanding (which I still don't understand well enough to implement without Prism).

Below I'm going to take a look at a couple of controls I've written MVVM on.  Finding documentation for MVVM in Universal Windows Plateform (UWP) is tricky.  It is similar to XamarinForms and WPF, but overall, there are syntax differences which make generalizing the documentation difficult.

First though, here's how I structured my project:

MainPage.xaml = View MainViewViewModel = ViewModel *[Not Yet Written] = Model

Below is some code for a couple of UI controls.

First, taking a look at the four text boxes which will hold the network IDs and host IDs the user is to type in:

MainPage.xaml

    ....
    <TextBox x:Name="NetworkIDOne" Text="{Binding HostIDOne, Mode=TwoWay}" VerticalAlignment="Center" HorizontalAlignment="Stretch" TextAlignment="Center" Grid.Column="1"/>
    <TextBox x:Name="NetworkIDTwo" Text="{Binding HostIDTwo, Mode=TwoWay}" VerticalAlignment="Center" HorizontalAlignment="Stretch" TextAlignment="Center" Grid.Column="2"/>
    <TextBox x:Name="HostIDOne" Text="{Binding NetworkIDOne, Mode=TwoWay}" VerticalAlignment="Center" HorizontalAlignment="Stretch" TextAlignment="Center" Grid.Column="3"/>
    <TextBox x:Name="HostIDTwo" Text="{Binding NetworkIDTwo, Mode=TwoWay}" VerticalAlignment="Center" HorizontalAlignment="Stretch" TextAlignment="Center" Grid.Column="4"/>
    ....

This sets up the binding to the variables HostIDOne, HostIDTwo, NetworkIDOne, NetworkIDTwo.  However, there's plenty more boilerplate code before things start working.

To setup a ViewModel it's best to setup an abstract class which can be inherited.  This saves on creating boilerplate.  Below is the abstract class the internet told me to make:

MainViewModelBase.cs

    public abstract class MainViewModelBase : INotifyPropertyChanged
    {
        public event PropertyChangedEventHandler PropertyChanged;
        protected virtual void OnPropertyChanged(string propertyName)
        {
            this.PropertyChanged?.Invoke(this, new PropertyChangedEventArgs(propertyName));
        }
    }

This code handles the property changing notification for all properties declared in classes which inherit from the MainViewModelBase.  Such as the MainViewViewModel which is used in Lumi4

MainViewViewModel.cs

    ....
        public class MainViewViewModel: MainViewModelBase
        {
    ....

Moving on to the actual implementation of the bound text boxes.  Each text box will have a property associated with the string value in the Text attribute.  However, before this will work, the DataContext must be set for the MainPage.xaml.  This is done in the MainPage.xaml.cs file.

MainPage.xaml.cs

    public MainPage()
    {
        this.InitializeComponent();
        DataContext = new Lumi4App.ViewModels.MainViewViewModel();

(I told you it was a lot of work to setup.  Well, compared to Xcode's MVC.)

Ok, everything should be in place, time to implement the bound properties.  In the MainViewViewModel I've the following code:

    private string _HostIDOne;
    public string HostIDOne
    {
        get { return _HostIDOne; }
        set {
            if (_HostIDOne != value)
            {
                _HostIDOne = value;
            }
        }
    }

    private string _HostIDTwo;
    public string HostIDTwo
    {
        get { return _HostIDTwo; }
        set {
            if (_HostIDTwo != value)
            {
                _HostIDTwo = value;
            }
        }
    }

    private string _NetworkIDOne;
    public string NetworkIDOne
    {
        get { return _NetworkIDOne; }
        set {
            if (_NetworkIDOne != value)
            {
                _NetworkIDOne = value;
            }
        }
    }

    private string _NetworkIDTwo;
    public string NetworkIDTwo
    {
        get { return _NetworkIDTwo; }
        set {
            if (_NetworkIDTwo != value)
            {
                _NetworkIDTwo = value;
            }
        }
    }

The if statement under the setter checks if the value about to be set is the same as the value is currently.  Note, there is a helper in Prism which will prevent one from having to rewrite this for every attribute.  However, I implemented the above code before I downloaded Prism and decided to write this article while it was still fresh in my mind.  I'll probably correct these to use the Prism helper before moving.

The code so far should allow for the properties setter to be called whenever the user types something in one of the four textboxes. On caveat, it seems the setter is not called until the user removes focus from the textbox.  I'll probably need to change the binding of the properties, but for now, it works well enough.

Well, this is all fine and gone, but what about Commands such as Button Click Events?  Pretty simple, but with more boilerplate code.

First, bind to the command in the View

MainPage.xaml

    <Button x:Name="Search" Command="{Binding SearchCommand, Mode=TwoWay}" Padding="2" >

Next, and this is the part I don't understand without Prism helping, there needs to be a delegate which will fire an event whenever the commad is called.  In Prism there is the DelegateCommand type which takes care of a lot of the work.  The DelegateCommand has to be initialized with two event handlers CanExecute and Execute.  These methods will be called in that order every time the DelegateCommand property is accessed.

MainViewViewModel.cs

    public DelegateCommand SearchCommand { get; set; }
    private bool SearchCanExecute()
    {
        return (CentralDeviceTypeSelected == CentralDeviceType.Http) ? true : false;
    }
    private void SearchExecute()
    {
        [Add Code to Do Stuff when the Search Button is pressed here]
    }

    ....

    public MainViewViewModel()
    {
        SearchCommand = new DelegateCommand(SearchExecute, SearchCanExecute);
    }

And that's it for now.  Had to make sure I jotted down my notes while the challenge was still fresh in my head.

Update: 4-16-2017

Apparently, a Prism ViewModel should inherit from BindableBase instead of the custom ViewModelBase the internet told me to write.  Also, to get the prismProp code snippet it looks like you have to download the Prism template packet:

* Prism Templates

And the intellisense phrase for the PrismProperty is "pprop".

Also, Brian Laguna (maintainer of Prism) has a video using Prism 6:

* MVVM Made Simple with Prism

Oh, and to make Prism work you need to get NuGet packages:

  1. Prism.Core
  2. Prism.Windows (contains ViewModelLocator)
Lumi4 -- Unit and Integration Tests

Unit and Integration Testing

I mentioned in an earlier entry that I had the hardest time differentiating between unit and integration tests.  But this distinction was critical for implementing tests which could cover frameworks designed to interact with embedded systems.  At least, in my perspective.  Below is an outline of how I'm structuring tests for the Lumi4 code base.

Lumi4.Tests

The unit tests namespace will contain all tests which cover methods which can be operate independtly, without communication of any other system then the program itself.

For example,

    [TestClass]
    public class Constructor
    {
        [TestMethod]
        public void WifiCentralManagerConstructor_Null_Exception()
        {
            bool ThrewNull = false;
            try
            {

                WifiCentralManager wifiCentralManager = new WifiCentralManager(null);
            }
            catch (Exception ex)
            {
                ThrewNull = true;
            }
            Assert.IsTrue(ThrewNull);
        }
    }

The test above covers a constructor method, which should always be able to execute effectively without any communication with a

Lumi4.IntegrationTests

In an earlier entry I reviewed the epiphanic difference between intergration and unit tests.  The intergration tests are really meant for code which relies on outside systems; database query result, characters from a filestream, or characters from a UART device.  For Lumi4 there are three systems which the program is depedent.

  1. Remote Bluetooth Device(s)
  2. Remote Wifi Device(s)
  3. Intel HEX Filestream

For the first two I've decided to focus on integration testing rather than mocks and stubs.  My reasoning is two fold, I will most likely be tweaking the firmware of the remote devices.  Secondly, I don't understand mocks and stubs yet.  Trying to focus on MVP .

Of course, when I finally put together a plan of action a new struggle arose.  A lot of my Bluetooth and Wifi handling was depedent on asynchronous callbacks.  And this isn't the easiest thing to tackle in MSTesting (which is the testing package I'm using for this iteration).  Eventually though, I hacked together the following logic

    [TestMethod]
    public async Task Search_FindsWebServer_ValidIp()
    {
        var localNetwork = Lumi4IntegrationTestSettings.LocalIP;
        WifiCentralManager wifiCentralManager = new WifiCentralManager(localNetwork);
        bool foundDevice = false;
        wifiCentralManager.DiscoveredDevice += delegate (object obj, DiscoveredDeviceEventArgs args)
        {
            if (args.DiscoveredPeripheral != null) { foundDevice = true; }
        };
        wifiCentralManager.Search(90, 120);
        await Task.Delay(Lumi4IntegrationTestSettings.SearchWifiCallbackDelay);
        Assert.IsTrue(foundDevice);
    }

There are a few inputs which most be manually provided to the test, for example, the LocalIP and the target device's IP.  Scoped at the top of the method is a flag which will identify whether the device was found. It then takes this information, sets up a in method delegate (callback), and attempts to contact the device. Lastly, there is an async delay whose purpose is to allow the search enough time to properly execute. If the test finds the device within the given time, the callback is fired, and the flag set true. Otherwise, it returns failed.

Not sure of the validity, but it's what I got (so far).

source(hmisFunctions)

# Time period: 1/1/2016-12/31/2016
# Include 
# Active in emergency shelter
# Active in transitional housing

setwd(hmisDataPath)
client <- loadClient()
enrollment <- loadEnrollment()
project <- loadProject()
exit <- loadExit()

enrollment$EntryDate <- as.character(enrollment$EntryDate)
exit$ExitDate <- as.character(exit$ExitDate)

targetEnrollments <- sqldf("SELECT *
                        FROM enrollment
                        WHERE EntryDate < '2016-12-31'
                        ")

targetExits <- sqldf("SELECT *
                    FROM exit
                     WHERE ExitDate < '2016-01-01'
                     ")

activeEnrollment <- getActiveHudEnrollments(targetEnrollments, targetExits, project)
activeEnrollmentSelect <- sqldf("SELECT PersonalID, ProjectEntryID, ProjectType, EntryDate, ExitDate FROM activeEnrollment")

transitionalHousing <- sqldf("SELECT *
                                  FROM activeEnrollmentSelect
                                  WHERE ProjectType = 2
                                  ")

thPersonalIDs <- sqldf("SELECT DISTINCT(PersonalID) FROM transitionalHousing")

remove(list=c("targetEnrollments", "targetExits", "activeEnrollment", "activeEnrollmentSelect", "transitionalHousing"))

################
# ES LTB Count #
################
ltbESEnrollment <- sqldf("SELECT *
                        FROM enrollment
                         WHERE EntryDate < '2016-12-31'
                         ")

ltbESEnrollment <- addProjectInfoToEnrollment(ltbESEnrollment, project)
ltbESEnrollment <- sqldf("SELECT *
                         FROM ltbESEnrollment
                         WHERE TrackingMethod = 0
                         ")

ltbESExits <- sqldf("SELECT *
                     FROM exit
                     WHERE ExitDate < '2016-01-01'
                     ")

activeltbESEnrollments <- getActiveHudEnrollments(ltbESEnrollment, ltbESExits, project)
activeltbESEnrollments <- sqldf("SELECT PersonalID, ProjectEntryID, ProjectType, EntryDate, ExitDate FROM activeltbESEnrollments")

ltbESPersonalIDs <- sqldf("SELECT DISTINCT(PersonalID) FROM activeltbESEnrollments")

remove(list=c("ltbESEnrollment", "ltbESExits", "activeltbESEnrollments"))

################
# NBN  Count   #
################

services <- loadServices()

nbnServices <- sqldf("SELECT * 
                     FROM services
                     WHERE RecordType = 200
                     ")

nbnServices$DateProvided <- as.character(nbnServices$DateProvided)

nbnServicesInRange <- sqldf("SELECT *
                            FROM nbnServices
                            WHERE DateProvided > '2016-01-01'
                            AND DateProvided < '2016-12-31'
                            ")

nbnPersonalIDs <- sqldf("SELECT DISTINCT(PersonalID) FROM nbnServicesInRange")

###################
# Outreach  Count #
###################

outreachServices <- sqldf("SELECT * 
                     FROM services
                     WHERE RecordType = 12
                     ")

outreachServices$DateProvided <- as.character(outreachServices$DateProvided)

outreachServicesInRange <- sqldf("SELECT *
                            FROM outreachServices
                            WHERE DateProvided > '2016-01-01'
                            AND DateProvided < '2016-12-31'
                            ")

outreachPersonalIDs <- sqldf("SELECT DISTINCT(PersonalID) FROM outreachServicesInRange")

remove(list=c("outreachServicesInRange", "outreachServices"))

##########
# Totals #
##########

totalHomelessInRange <- rbind(ltbESPersonalIDs, thPersonalIDs, nbnPersonalIDs, outreachPersonalIDs)

totalHomelessInRange <- sqldf("SELECT DISTINCT(PersonalID)
                              FROM totalHomelessInRange
                              ")

#############
# PH Counts #
#############

phTargetEnrollments <- sqldf("SELECT *
                        FROM enrollment
                           WHERE EntryDate < '2016-12-31'
                           ")

phTargetExits <- sqldf("SELECT *
                     FROM exit
                     WHERE ExitDate < '2016-01-01'
                     ")

phActiveEnrollment <- getActiveHudEnrollments(phTargetEnrollments, phTargetExits, project)
phActiveEnrollmentSelect <- sqldf("SELECT PersonalID, ProjectEntryID, ProjectType, EntryDate, ExitDate FROM phActiveEnrollment")

totalPhHousing <- sqldf("SELECT *
                             FROM phActiveEnrollmentSelect
                             WHERE ProjectType = 3
                             OR ProjectType = 13
                             ")

rrhHousing <- sqldf("SELECT *
                    FROM phActiveEnrollmentSelect
                    WHERE ProjectType = 13
                    ")

psh <- sqldf("SELECT *
             FROM phActiveEnrollmentSelect
             WHERE ProjectType = 3
             ")

setwd(executionPath)
Choropleth and Heatmaps for HMIS Data

# Mac PC
nameOfReport <- "Homebase_Report.R"
hmisDataPath <- "C:/Users/Ladvien/Dropbox/HMIS/Warehouse/All Projects 2016 -- 10-01-2013 to 02-17-2017 -- HMIS CSV 5.1"
vispdatDataPath <- "C:/Users/Ladvien/Dropbox/HMIS/Coordinated_Entry_Report/VI-SPDAT and HUD Flat Export for SQL -- 3-6-2017.xlsx"
staffInfoDataPath <- "C:/Users/Ladvien/Dropbox/HMIS/Coordinated_Entry_Report/Staff Contact Info for SQL -- 3-6-2017.xlsx"
executionPath <- "C:/Users/Ladvien/Dropbox/HMIS/Coordinated_Entry_Report"
hmisFunctions <- "C:/Users/Ladvien/Dropbox/HMIS/HMIS_R_Functions/HMIS_R_Functions.R"
hmisGraphsPath <- "C:/Users/Ladvien/Dropbox/HMIS/Warehouse/TX-601_Graphs"
source(hmisFunctions)

enrollment <- loadEnrollment(hmisDataPath)

##############################################
############## Point Map #####################
##############################################

# https://thedhrelay.wordpress.com/2014/04/08/creating-a-density-map-in-r-with-zipcodes/

library(plyr)
library(ggmap)
library(zipcode)

personalIDsAndZips <- sqldf("SELECT PersonalID, LastPermanentZIP FROM enrollment")
rm(list = c("enrollment"))

# Clean zips
data(zipcode)
personalIDsAndZips$LastPermanentZIP <- clean.zipcodes(personalIDsAndZips$LastPermanentZIP)
personalIDsAndZips <- merge(personalIDsAndZips, zipcode, by.x = 'LastPermanentZIP', by.y = 'zip')

# Get density
zipCount <- sqldf("SELECT LastPermanentZIP, COUNT(LastPermanentZIP) As Count FROM personalIDsAndZips GROUP BY LastPermanentZIP")
personalIDsAndZips <- sqldf("SELECT * FROM personalIDsAndZips a LEFT JOIN zipCount b ON a.LastPermanentZIP=b.LastPermanentZIP ")
personalIDsAndZips <- subset(personalIDsAndZips)
zipCounts <- sqldf("SELECT DISTINCT LastPermanentZIP, longitude, latitude, COUNT(LastPermanentZIP) As 'Count' FROM personalIDsAndZips GROUP BY LastPermanentZIP")

texas <- get_map(location = c("dfw"), zoom = 9)
mapOfEntrants <- ggmap(texas) +
    geom_point(data = zipCounts,
    aes(x = longitude,
        y = latitude,
        size = Count,
        alpha = Count), color = "red") +
    ylab("Latitude") +
    xlab("Longitude") +
    labs(title = "Residence Prior to Project Entry", size = "Entrants", alpha = "Entrants")

svg(filename = paste(hmisGraphsPath, "/ResidencePriorToProjectEntry.svg", sep = ""),
    width = 5,
    height = 4,
    pointsize = 12)
plot(mapOfEntrants)
dev.off()

##############################################
############## Heat Map ######################
############## County Partition ##############
##############################################
library(ggmap) #Load libraries
library(ggplot2)
hpars <- read.table("https://sites.google.com/site/arunsethuraman1/teaching/hpars.dat?revision=1") #Read in the density data

ggmap(texas, extent = "device") +
geom_density2d(data = zipCounts, aes(x = longitude, y = latitude), size = 0.3) +
stat_density2d(data = zipCounts,
                 aes(x = longitude, y = latitude, fill = ..level.., alpha = 1), size = 0.01,
                 bins = 16, geom = "polygon") + scale_fill_gradient(low = "green", high = "red") +
  scale_alpha(range = c(0, 0.3), guide = FALSE) #Plot

##############################################
############## Choropleth Map ################
##############################################

# https://blogs.uoregon.edu/rclub/2015/10/27/map-maker-map-maker-make-me-a-map/
# https://www.gislounge.com/mapping-county-demographic-data-in-r/
install.packages(c("choroplethr", "choroplethrMaps"))
library(choroplethr)
library(choroplethrMaps)

# Clean up zipcodes.
valid <- read.csv("C:/Users/Ladvien/Dropbox/HMIS/Warehouse/ValidZips.csv")
zipsAndCount <- sqldf("SELECT DISTINCT(LastPermanentZIP) As 'region', COUNT(LastPermanentZIP) As 'value' FROM personalIDsAndZips GROUP BY LastPermanentZIP")
zipsAndCount <- na.omit(zipsAndCount)
zipsAndCount$value <- clean.zipcodes(zipsAndCount$value)
zipsAndCount <- sqldf("SELECT a.* FROM zipsAndCount a INNER JOIN valid b ON a.region=b.ValidZip")
zipsAndCount$value <- as.numeric(zipsAndCount$value)
#zipsAndCount$region <- as.numeric(zipsAndCount$region)

# http://stackoverflow.com/questions/30787877/making-a-zip-code-choropleth-in-r-using-ggplot2-and-ggmap
install.packages("devtools")
library(devtools)
install_github('arilamstein/choroplethrZip@v1.5.0')
library(choroplethrZip)

dallas_zips <- c("75019", "75039", "75038", "75041", "75040", "75043", "75042", "75044", "75049", "75048", "75051", "75050", "75052", "75054", "75061", "75060", "75063", "75062", "75080", "75082", "75081", "75089", "75088", "75099", "75104", "75106", "75115", "75116", "75125", "75134", "75137", "75141", "75146", "75150", "75149", "75154", "75159", "75172", "75181", "75180", "75182", "75202", "75201", "75204", "75203", "75206", "75205", "75208", "75207", "75210", "75209", "75212", "75211", "75215", "75214", "75217", "75216", "75219", "75218", "75220", "75223", "75222", "75225", "75224", "75227", "75226", "75229", "75228", "75231", "75230", "75233", "75232", "75235", "75234", "75237", "75236", "75238", "75241", "75240", "75243", "75242", "75244", "75247", "75246", "75249", "75248", "75251", "75250", "75253", "75254", "75260", "75275", "75283", "75284", "75326", "75359", "75381", "75001", "75390", "75006", "75007", "75397", "75015", "75014", "75016")
dallas_zips <- unique(dallas_zips)
# ec = east coast
texas = c("texas")
zip_choropleth(zipsAndCount,
               state_zoom = texas,
               title = "Residence Prior to Entry",
               legend = "Entrants",
               num_color = 5,
               reference_map = TRUE
               ) +
               coord_map()

############## Get Dallas ZIP codes ######################
dallasClients <- sqldf("SELECT * FROM enrollment 
                        WHERE 
        LastPermanentZIP = '75019' OR
        LastPermanentZIP = '75039' OR
        LastPermanentZIP = '75038' OR
        LastPermanentZIP = '75041' OR
        LastPermanentZIP = '75040' OR
        LastPermanentZIP = '75043' OR
        LastPermanentZIP = '75042' OR
        LastPermanentZIP = '75044' OR
        LastPermanentZIP = '75049' OR
        LastPermanentZIP = '75048' OR
        LastPermanentZIP = '75051' OR
        LastPermanentZIP = '75050' OR
        LastPermanentZIP = '75052' OR
        LastPermanentZIP = '75054' OR
        LastPermanentZIP = '75061' OR
        LastPermanentZIP = '75060' OR
        LastPermanentZIP = '75063' OR
        LastPermanentZIP = '75062' OR
        LastPermanentZIP = '75080' OR
        LastPermanentZIP = '75082' OR
        LastPermanentZIP = '75081' OR
        LastPermanentZIP = '75089' OR
        LastPermanentZIP = '75088' OR
        LastPermanentZIP = '75099' OR
        LastPermanentZIP = '75104' OR
        LastPermanentZIP = '75106' OR
        LastPermanentZIP = '75115' OR
        LastPermanentZIP = '75116' OR
        LastPermanentZIP = '75125' OR
        LastPermanentZIP = '75134' OR
        LastPermanentZIP = '75137' OR
        LastPermanentZIP = '75141' OR
        LastPermanentZIP = '75146' OR
        LastPermanentZIP = '75150' OR
        LastPermanentZIP = '75149' OR
        LastPermanentZIP = '75154' OR
        LastPermanentZIP = '75159' OR
        LastPermanentZIP = '75172' OR
        LastPermanentZIP = '75181' OR
        LastPermanentZIP = '75180' OR
        LastPermanentZIP = '75182' OR
        LastPermanentZIP = '75202' OR
        LastPermanentZIP = '75201' OR
        LastPermanentZIP = '75204' OR
        LastPermanentZIP = '75203' OR
        LastPermanentZIP = '75206' OR
        LastPermanentZIP = '75205' OR
        LastPermanentZIP = '75208' OR
        LastPermanentZIP = '75207' OR
        LastPermanentZIP = '75210' OR
        LastPermanentZIP = '75209' OR
        LastPermanentZIP = '75212' OR
        LastPermanentZIP = '75211' OR
        LastPermanentZIP = '75215' OR
        LastPermanentZIP = '75214' OR
        LastPermanentZIP = '75217' OR
        LastPermanentZIP = '75216' OR
        LastPermanentZIP = '75219' OR
        LastPermanentZIP = '75218' OR
        LastPermanentZIP = '75220' OR
        LastPermanentZIP = '75223' OR
        LastPermanentZIP = '75222' OR
        LastPermanentZIP = '75225' OR
        LastPermanentZIP = '75224' OR
        LastPermanentZIP = '75227' OR
        LastPermanentZIP = '75226' OR
        LastPermanentZIP = '75229' OR
        LastPermanentZIP = '75228' OR
        LastPermanentZIP = '75231' OR
        LastPermanentZIP = '75230' OR
        LastPermanentZIP = '75233' OR
        LastPermanentZIP = '75232' OR
        LastPermanentZIP = '75235' OR
        LastPermanentZIP = '75234' OR
        LastPermanentZIP = '75237' OR
        LastPermanentZIP = '75236' OR
        LastPermanentZIP = '75238' OR
        LastPermanentZIP = '75241' OR
        LastPermanentZIP = '75240' OR
        LastPermanentZIP = '75243' OR
        LastPermanentZIP = '75242' OR
        LastPermanentZIP = '75244' OR
        LastPermanentZIP = '75247' OR
        LastPermanentZIP = '75246' OR
        LastPermanentZIP = '75249' OR
        LastPermanentZIP = '75248' OR
        LastPermanentZIP = '75251' OR
        LastPermanentZIP = '75250' OR
        LastPermanentZIP = '75253' OR
        LastPermanentZIP = '75254' OR
        LastPermanentZIP = '75260' OR
        LastPermanentZIP = '75275' OR
        LastPermanentZIP = '75283' OR
        LastPermanentZIP = '75284' OR
        LastPermanentZIP = '75326' OR
        LastPermanentZIP = '75359' OR
        LastPermanentZIP = '75381' OR
        LastPermanentZIP = '75001' OR
        LastPermanentZIP = '75390' OR
        LastPermanentZIP = '75006' OR
        LastPermanentZIP = '75007' OR
        LastPermanentZIP = '75397' OR
        LastPermanentZIP = '75015' OR
        LastPermanentZIP = '75014' OR
        LastPermanentZIP = '75016'
")

# Clean up zipcodes.
valid <- read.csv("C:/Users/Ladvien/Dropbox/HMIS/Warehouse/ValidZips.csv")
zipsAndCount <- sqldf("SELECT DISTINCT(LastPermanentZIP) As 'region', COUNT(LastPermanentZIP) As 'value' FROM dallasClients GROUP BY LastPermanentZIP")
zipsAndCount <- na.omit(zipsAndCount)
zipsAndCount$value <- clean.zipcodes(zipsAndCount$value)
zipsAndCount <- sqldf("SELECT DISTINCT a.* FROM zipsAndCount a INNER JOIN valid b ON a.region=b.ValidZip")
zipsAndCount$value <- as.numeric(zipsAndCount$value)

zipsOfInterest <- sqldf("SELECT DISTINCT(region) FROM zipsAndCount")
zipsOfInterest <- unique(zipsOfInterest$region)

library(choroplethrZip)
# ec = east coast
texas = c("dallas")
zip_choropleth(zipsAndCount,
               zip_zoom = zipsOfInterest,
               title = "Residence Prior to Entry",
               legend = "Entrants",
               num_color = 5,
               reference_map = TRUE
               ) + coord_map()
Veteran's Report 2.0

#homebaseFunctionFilePath <- "C:/Users/Ladvien/Dropbox/HMIS/Homebase_Function/Homebase_Function.R"
#nameOfReport <- "Homebase_Report.R"
#hmisDataPath <- "C:/Users/Ladvien/Dropbox/HMIS/Warehouse/All Programs -- 5.1 -- 12-1-2016 to 2-28-2017"
#vispdatDataPath <- "C:/Users/Ladvien/Dropbox/HMIS/Coordinated_Entry_Report/VI-SPDAT and HUD Flat Export for SQL -- 3-6-2017.xlsx"
#staffInfoDataPath <- "C:/Users/Ladvien/Dropbox/HMIS/Coordinated_Entry_Report/Staff Contact Info for SQL -- 3-6-2017.xlsx"
#executionPath <- "C:/Users/Ladvien/Dropbox/HMIS/Coordinated_Entry_Report"
#hmisFunctionsFilePath <- "C:/Users/Ladvien/Dropbox/HMIS/HMIS_R_Functions/HMIS_R_Functions.R"
#homebaseFunctionFilePath <- "C:/Users/Ladvien/Dropbox/HMIS/Homebase_Function/Homebase_Function.R"
#outputPath <- "C:/Users/Ladvien/Dropbox/HMIS/Warehouse"
#veteranMasterListTemplateFilePath <- "C:/Users/Ladvien/Dropbox/HMIS/Veteran Report 2.0/Veteran_Report_v2/Master-List-Template.csv"

# PC
nameOfReport <- "Homebase_Report.R"
hmisDataPath <- "C:/Users/Ladvien/Dropbox/HMIS/Warehouse/All Program 2016 Program Group, 1012013 - 2172017"
vispdatDataPath <- "C:/Users/Ladvien/Dropbox/HMIS/Warehouse/VI-SPDAT 1/VI-SPDAT and HUD Flat Export for SQL -- 3-6-2017.xlsx"
vispdat2DataPath <- "C:/Users/Ladvien/Dropbox/HMIS/Warehouse/VI-SPDAT 2/VI-SPDAT v2.0 -- 04-05-17 -- TB.xlsx"
staffInfoDataPath <- "C:/Users/Ladvien/Dropbox/HMIS/Warehouse/Staff Info/Staff Contact Info for SQL -- 3-6-2017.xlsx"
executionPath <- "C:/Users/Ladvien/Dropbox/HMIS/Veteran Report 2.0"
hmisFunctionsFilePath <- "C:/Users/Ladvien/Dropbox/HMIS/HMIS_R_Functions/HMIS_R_Functions.R"
homebaseFunctionFilePath <- "C:/Users/Ladvien/Dropbox/HMIS/Homebase_Function/Homebase_Function.R"
outputPath <- "C:/Users/Ladvien/Dropbox/HMIS/Warehouse"
veteranMasterListTemplateFilePath <- "C:/Users/Ladvien/Dropbox/HMIS/Veteran Report 2.0/Veteran_Report_v2/Master-List-Template.csv"
outputPath <- "C:/Users/Ladvien/Dropbox/HMIS/Warehouse/Veteran Report Master List/"

# Load HMIS Functions
source(hmisFunctionsFilePath)
# Load Homebase function
source(homebaseFunctionFilePath)

homebase <- homebase(hmisDataPath,
                 vispdatDataPath,
                 staffInfoDataPath,
                 executionPath,
                 hmisFunctionsFilePath,
                 vispdat2DataPath
                 )

client <- loadClient(hmisDataPath)
enrollment <- loadEnrollment(hmisDataPath)
exit <- loadExit(hmisDataPath)
project <- loadProject(hmisDataPath)
projectCoc <- loadProjectCoc(hmisDataPath)

# Elements for the BFZ Veteran's Master List:

    #E1  Veteran Last Name
    #E2  Veteran First Name
    #E3  Veteran HMIS Client Identifier
    #E4  Veterans HOMES Client Identifier
    #E5  List Status
    #E6  Date Veteran Identified
    #E7  Last Review / Update on Master List
    #E8  Last known Location / Provider
    #E9  Confirmed Veteran Status?
    #E10 VHA Eligible
    #E11 SSVF Eligible
    #E12 Permant Housing Plan / Track
    #E13 Expected Permanent Housing Date
    #E14 Client Phone or Email if known
    #E15 Veteran DoB
    #E16 Assessment Score
    #E17 Chronic Status
    #E18 Provider Name and Contact
    #E19 Current Project Enrollment Type
    #E20 Date Permanent Housing Plan Created
    #E21 Permanent Housing Plan Notes
    #E22 Date of Move to TH, including GPD
    #E23 Exit Destination - Permanent Housing
    #E24 Date of Permanent Housing Placement / Exit from Literal Homelessness
    #E25 Exit Destination – Other(non - PH, non - literal homeless exits)
    #E26 Date of Other Exit

    ## Below are elements which will need to be added and rolled from month-to-month.

    #E27 Notes and Additional Information
    #E28 Date of Permanent Housing Intervention Offer
    #E29 Type of PH Intervention Offered
    #E30 Accept or Decline Offer
    #E31 Date of Accept or Decline
    #E32 Date of Permanent Housing Intervention Offer
    #E33 Type of PH Intervention Offered
    #E34 Accept or Decline Offer
    #E35 Date of Accept or Decline
    #E36 Date of Permanent Housing Intervention Offer
    #E37 Type of PH Intervention Offered
    #E38 Accept or Decline Offer
    #E39 Date of Accept or Decline
    #E40 Date of Permanent Housing Intervention Offer
    #E41 Type of PH Intervention Offered
    #E42 Accept or Decline Offer
    #E43 Date of Accept or Decline
    #E44 Date of Permanent Housing Intervention Offer
    #E45 Type of PH Intervention Offered
    #E46 Accept or Decline Offer
    #E47 Date of Accept or Decline
    #E48 Date of Permanent Housing Intervention Offer
    #E49 Type of PH Intervention Offered
    #E50 Accept or Decline Offer
    #E51 Date of Accept or Decline
    #E52 Date of Permanent Housing Intervention Offer
    #E53 Type of PH Intervention Offered
    #E54 Accept or Decline Offer
    #E55 Date of Accept or Decline
    #E56 Days Since Veteran Identified
    #E57 Days from Veteran Identification to Housing Plan Creation
    #E58 Days Since Veteran Permanent Housing Plan Created
    #E59 Days from Identification to Permanent Housing
    #E60 Days Since Permanent Housing Placement / Exit from Literal Homelessness

homebase_vets <- sqldf("SELECT *
                        FROM homebase
                        WHERE VeteranStatus = 'Yes'
                        ")
remove(list = c("homebase"))

# Get the whether the participant is actively homeless.

#E5  List Status
master_list_builder <- sqldf("SELECT *, CASE LastProjectTypeContacted
                        WHEN 'PH - Permanent Supportive Housing' THEN 'Inactive (Permanently Housed)'
                        WHEN 'Emergency Shelter' OR 'Transitional Housing' THEN 'Active - ES/TH'
                        WHEN 'Street Outreach' THEN 'Active - unsheltered'
                        END As ListStatus
                        FROM homebase_vets")

#E12 Permant Housing Plan / Track
master_list_builder <- sqldf("SELECT *, CASE 
              WHEN ChronicallyHomeless = 'Yes' THEN 'Permanent Supportive Housing'
              ELSE 'Rapid Rehousing'
              END As'Permanent Housing Plan / Track'
              FROM master_list_builder
              ")

#E22 Date of Move to TH, including GPD
master_list_builder <- sqldf("SELECT *, CASE
                              WHEN LastProjectTypeContacted = 'Transitional Housing' THEN RecentHUDEntryDate
                              ELSE ''
                              END As THMoveIn
                              FROM master_list_builder
                              ")

#E24 Date of Permanent Housing Placement / Exit from Literal Homelessness
master_list_builder <- sqldf("SELECT *, CASE
                              WHEN ActiveInPH = 'Yes' THEN RecentHUDEntryDate
                              ELSE ''
                              END As PHMoveIn
                              FROM master_list_builder
                              ")
master_list_builder <- subset(master_list_builder)

############ FILTERING ##################

####################################
# Filter:                          #
# Active (in 90 days) in NBN ES    #
####################################
services <- loadServices(hmisDataPath)

# Filter out NBN at TCES, get active NBN list, add them back in.
master_list_builder_bfr <- sqldf("SELECT *
                              FROM master_list_builder
                              WHERE LastProgramInContact != 'Salvation Army' 
                              AND LastProgramInContact != 'Presbyterian Night Shelter'
                              AND LastProgramInContact != 'Day Resource Center'
    ")

nbnServices <- sqldf("SELECT * 
                      FROM services
                      WHERE RecordType = 200
    ")

activeNbnSerivces <- activeFilter(nbnServices, 'DateProvided', 'DateProvided', as.character(Sys.Date() - 90), as.character(Sys.Date()))
filter_Active_in_90_NBN <- sqldf("SELECT DISTINCT(PersonalID) FROM activeNbnSerivces")

activeNbnRecords <- sqldf("SELECT b.*
                           FROM filter_Active_in_90_NBN a
                           INNER JOIN master_list_builder b
                           ON a.PersonalID=b.PersonalID
                        ")

master_list_builder <- rbind(master_list_builder_bfr, activeNbnRecords)

####################################
# Filter:                          #
# Active (in 90 days) in Outreach  #
####################################

# Filter out Outreach, get active Outreach, then add back in.
master_list_builder_bfr <- sqldf("SELECT *
                              FROM master_list_builder
                              WHERE LastProgramInContact != 'SOS' 
                              AND LastProgramInContact != 'SOS Night Time Outreach'
                              AND LastProgramInContact != 'PATH'
    ")

outreachServices <- sqldf("SELECT * 
                      FROM services
                      WHERE RecordType = 12
    ")

activeOutreachSerivces <- activeFilter(outreachServices, 'DateProvided', 'DateProvided', as.character(Sys.Date() - 90), as.character(Sys.Date()))
filter_Active_in_90_Outreach <- sqldf("SELECT DISTINCT(PersonalID) FROM activeOutreachSerivces")

activeOutreachRecords <- sqldf("SELECT b.*
                           FROM filter_Active_in_90_Outreach a
                           INNER JOIN master_list_builder b
                           ON a.PersonalID=b.PersonalID
                        ")

remove(list = c("services"))

master_list_builder <- rbind(master_list_builder_bfr, activeOutreachRecords)
master_list_builder <- sqldf("SELECT DISTINCT * FROM master_list_builder")

#######################################
# Reload Data for Entry / Exit Filter #
#######################################
enrollment <- loadEnrollment(hmisDataPath)
exit <- loadExit(hmisDataPath)
project <- loadProject(hmisDataPath)

####################################
# Filter:                          #
# Active in a Entry Exit ES        #
####################################

activeEEESProgramsFilter_builder <- sqldf("SELECT a.ProjectEntryID, a.PersonalID, a.EntryDate, b.ProjectName, b.ProjectType 
                               FROM enrollment a
                               LEFT JOIN project b
                               ON a.ProjectID=b.ProjectID 
    ")

# 1 = Emergency Shelter
# 11 = Day Shelter
activeEEESProgramsFilter_builder <- sqldf("SELECT * 
                               FROM activeEEESProgramsFilter_builder 
                               WHERE (ProjectType = 1 OR ProjectType = 11)
                               AND (ProjectName != 'Salvation Army' 
                                   AND ProjectName != 'Presbyterian Night Shelter'
                                   AND ProjectName != 'Day Resource Center'
                                   AND ProjectName != 'SOS'
                                   AND ProjectName != 'SOS Night Time Outreach'
                                   AND ProjectName != 'PATH')")

activeEEESProgramsFilter_builder <- sqldf("SELECT a.*, b.ExitDate
                                       FROM activeEEESProgramsFilter_builder a
                                       LEFT JOIN exit b
                                       ON a.ProjectEntryID=b.ProjectEntryID
    ")

activeEEESProgramsFilter_builder <- subset(activeEEESProgramsFilter_builder)
filter_Active_in_EEES <- sqldf("SELECT DISTINCT PersonalID FROM activeEEESProgramsFilter_builder WHERE ExitDate IS NULL")

remove(list = c("activeEEESProgramsFilter_builder"))

####################################
# Filter:                          #
# Active in a Transitional Housing #
####################################

activeTHProgramFilter_builder <- sqldf("SELECT a.ProjectEntryID, a.PersonalID, a.EntryDate, b.ProjectName, b.ProjectType 
                               FROM enrollment a
                               LEFT JOIN project b
                               ON a.ProjectID=b.ProjectID 
    ")

# 2 = Transitional Housing
activeTHProgramFilter_builder <- sqldf("SELECT * 
                               FROM activeTHProgramFilter_builder 
                               WHERE (ProjectType = 2)")

activeTHProgramFilter_builder <- sqldf("SELECT a.*, b.ExitDate
                                       FROM activeTHProgramFilter_builder a
                                       LEFT JOIN exit b
                                       ON a.ProjectEntryID=b.ProjectEntryID
    ")

activeTHProgramFilter_builder <- subset(activeTHProgramFilter_builder)
filter_Active_in_TH <- sqldf("SELECT DISTINCT PersonalID FROM activeTHProgramFilter_builder WHERE ExitDate IS NULL")

remove(list = c("activeTHProgramFilter_builder"))

####################################
# Get First Date in Homelessness   #
####################################

project <- loadProject(hmisDataPath)
enrollment <- loadEnrollment(hmisDataPath)

enrollmentAndProject <- sqldf("SELECT a.PersonalID, a.EntryDate, b.ProjectName, b.ProjectType 
                               FROM enrollment a
                               LEFT JOIN project b
                               ON a.ProjectID=b.ProjectID 
    ")

# 1 = Emergency Shelter, 2 = Transitional Housing, 4 = Street Outreach, 8 = Safe Haven, 11 = Day Shelter, 14 = Coordinated Assessment
startDateInHomelessnessByPersonalID <- sqldf("SELECT PersonalID, MAX(EntryDate) As 'FirstContactDate' 
                                              FROM enrollmentAndProject
                                              WHERE ProjectType = 1 OR ProjectType = 2 OR ProjectType = 4 OR ProjectType = 8 OR ProjectType = 11 OR ProjectType = 14
                                              GROUP BY PersonalID
    ")

# Add FirstContactDate to master list.
master_list_builder <- sqldf("SELECT a.*, b.FirstContactDate As 'DateVeteranIdentified'
                              FROM master_list_builder a
                              LEFT JOIN startDateInHomelessnessByPersonalID b
                              ON a.PersonalID=b.PersonalID
    ")

####################################
# Get Exit Destination Information #
####################################

# Get Homebase information tied back to the record
master_list <- sqldf("SELECT FirstName As 'VeteransLastName',
                              LastName As 'VeteransFirstName',
                              PersonalID As 'Veteran HMIS Client Identifier',
                              'Unknown' As 'Veterans HOMES Client Identifier',
                              ListStatus As 'List Status',
                              DateVeteranIdentified,
                              'Unknown' As 'Last Review / Update On Master List',
                              LastProgramInContact As 'Last Known Location / Provider',
                              'Unknown' As 'Confirmed Veteran Status',
                              'Unknown' As 'VHA Eligible',
                              'Unknown' As 'SSVF Eligible',
                              'Unknown' As 'Permanent Housing Plan',
                              'Unknown' As 'Permanent Housing Plan / Track',
                              'Unknown' As 'Permanent Housing Date',
                              'Unknown' As 'Client Phone or Email',
                              DOB,
                              scoreVISPDAT As 'Assessment Score',
                              ChronicallyHomeless As 'Chronically Homeless',
                              LastProgramInContact As 'Provider Name',
                              StaffName As 'Provider: StaffName',
                              StaffEmail As 'Provider: Staff Email',
                              LastProjectTypeContacted As 'Current Project Enrollment Type',
                              'Unknown' As 'Date Permanent Housing Plan Created',
                              'Unknown' As 'Permanent Housing Plan Notes',
                              THMoveIn As 'Date of Move to TH, including GPD',
                              'Unknown' As 'Exit Destination - Permanent Housing',
                              PHMoveIn As 'Date of Permanent Housing Placement / Exit from Literal Homelessness',
                              'Unknown' As 'Exit Destination – Other(non - PH, non - literal homeless exits)',
                              'Unknown' As 'Date of Other Exit'
                              FROM master_list_builder
") 

master_list_ph <- sqldf("SELECT * FROM master_list_builder WHERE LastProjectTypeContacted = 'PH - Rapid Re-Housing' OR LastProjectTypeContacted = 'PH - Permanent Supportive Housing'")
master_list_es_and_so <- sqldf("SELECT * FROM master_list_builder WHERE LastProjectTypeContacted = 'Day Shelter' OR LastProjectTypeContacted = 'Emergency Shelter' OR LastProjectTypeContacted = 'Street Outreach'")

filter_active_homeless <- rbind(filter_Active_in_90_NBN, filter_Active_in_90_Outreach)
filter_active_homeless <- rbind(filter_active_homeless, filter_Active_in_EEES)
filter_active_homeless <- rbind(filter_active_homeless, filter_Active_in_TH)
filter_active_homeless <- unique(filter_active_homeless)
master_list_es_and_so_and_th <- sqldf("SELECT a.* 
                                       FROM master_list a
                                       INNER JOIN filter_active_homeless b
                                       ON a.'Veteran HMIS Client Identifier'=b.PersonalID")

colnames(master_list_es_and_so_and_th)[5] <- "ListStatus"
master_list_es_and_so_and_th <- sqldf("SELECT * FROM master_list_es_and_so_and_th WHERE ListStatus IS NOT 'Inactive (Permanently Housed)'")
colnames(master_list_es_and_so_and_th)[5] <- "List Status"

filter_active_houseless <- rbind(filter_Active_in_90_NBN, filter_Active_in_90_Outreach)
filter_active_houseless<- rbind(filter_active_houseless, filter_Active_in_EEES)
master_list_es_and_so <- sqldf("SELECT a.* 
                                       FROM master_list a
                                       INNER JOIN filter_active_houseless b
                                       ON a.'Veteran HMIS Client Identifier'=b.PersonalID
                                       ")
colnames(master_list_es_and_so)[5] <- "ListStatus"
master_list_es_and_so <- sqldf("SELECT * FROM master_list_es_and_so WHERE ListStatus IS NOT 'Inactive (Permanently Housed)'")
colnames(master_list_es_and_so)[5] <- "List Status"

detach("package:XLConnect", unload = TRUE)
library(xlsx)
outputPath <- paste(outputPath, "Veteran_Master_List_", Sys.Date(), ".xlsx", sep = "")
masterListSheetName <- paste("TX-601_Master_List_", Sys.Date(), paste = "")
masterListPhName <- paste("PSH_", Sys.Date(), paste = "")
masterListESName <- paste("ES_DS_SO_", Sys.Date(), paste = "")
masterListEAndThSName <- paste("ES_DS_SO_TH_", Sys.Date(), paste = "")

###############################
# Write Sheets                #
###############################

write.xlsx(master_list, file = outputPath, sheetName = masterListSheetName, row.names = FALSE, showNA = FALSE)
write.xlsx(master_list_ph, file = outputPath, sheetName = masterListPhName, row.names = FALSE, showNA = FALSE, append = TRUE)
write.xlsx(master_list_es_and_so, file = outputPath, sheetName = masterListESName, row.names = FALSE, showNA = FALSE, append = TRUE)
write.xlsx(master_list_es_and_so_and_th, file = outputPath, sheetName = masterListEAndThSName, row.names = FALSE, showNA = FALSE, append = TRUE)

ch <- sqldf("SELECT 'NumberOfCH', COUNT(PersonalID) FROM master_list_builder WHERE ChronicallyHomeless = 'Yes' AND LastProjectTypeContacted = 'Emergency Shelter'")