Latest Posts

April 07, 2017C. Thomas Brittain (Ladvien) Reading time ~2 minutes

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.

Remote Bluetooth Device(s)
Remote Wifi Device(s)
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).

April 06, 2017C. Thomas Brittain (Ladvien) Reading time ~1 minute

Annualized Count

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)

April 02, 2017C. Thomas Brittain (Ladvien) Reading time ~5 minutes

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

March 30, 2017C. Thomas Brittain (Ladvien) Reading time ~8 minutes

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'")

Ladvien's Lab

Latest Posts

Unit and Integration Testing

Lumi4.Tests

Lumi4.IntegrationTests