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()