Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: d2fc4af6ed
Fetching contributors…

Cannot retrieve contributors at this time

76 lines (63 sloc) 2.932 kB
import System.IO
import qualified Data.Map as Map (toList, map, elems, lookup, unionsWith, empty, unionWith)
import Data.List (intercalate, intersect, sort, nub)
import Data.Maybe (mapMaybe, catMaybes)
import qualified Data.Map as Map (showTreeWith)
import Text.Printf
import Data.Time.Clock
import Utility.Database
import Utility.General
import QRDA.Shared
import QRDA.Patient
import QRDA.Measure
fold2 :: (a -> b -> a) -> (c -> d -> c) -> (a, c) -> [(b, d)] -> (a, c)
fold2 f1 f2 = foldl (\(xs, ys) (x, y) -> (f1 xs x, f2 ys y))
patientProviders :: MeasureSectionEntries -> [Provider]
patientProviders = nub . map entryProvider . concat . (!!! "Encounters")
where m !!! k = catMaybes . Map.elems $ Map.map (Map.lookup k) m
getData :: Patient -> MeasureSectionEntries -> [Measure] -> [(Provider, [Classification Measure], SectionEntries)]
getData patient sections measures =
map (\(provider, (x, y)) -> (provider, x, y)) providerData
where providerData = mapMaybe (\provider ->
case mapMaybe (patientQualifies patient provider sections) {-measures-} (measures `intersect` providerMeasures provider) of
[] -> Nothing
results -> Just (provider, fold2 (\agg x -> agg ++ [x]) (Map.unionWith (++)) ([], Map.empty) results)
) (patientProviders sections)
showMeasure (Numerator x) = x ++ "-N"
showMeasure (Exclusion x) = x ++ "-X"
showMeasure (Neither x) = x
showMeasure (Counter num x) = x ++ "-" ++ show num
output patient entries results = do
withFile ("debugging/" ++ patientMrn patient ++ ".txt") WriteMode (\handle ->
mapM (\sections ->
mapM (hPutStrLn handle . unlines . map show) $ Map.elems sections
) $ Map.elems entries
)
mapM_ (\(provider, measures, result) ->
withFile
("output/" ++ intercalate "_" (patientMrn patient : show provider : map showMeasure measures) ++ ".txt")
WriteMode
(\handle -> do
hPutStrLn handle $ patientMrn patient
mapM_ (hPutStrLn handle) $ map (unlines . map show) $ Map.elems result
)
) results
main = do
connectionString <- fmap ConnectionString $ readFile "X:/LVPG PI/Quality/PROJECTS/ZACH - QRDA/connectionString.config"
measures <- fmap lines $ readFile "X:/LVPG PI/Quality/PROJECTS/ZACH - QRDA/measures.config"
-- measures <- return ["317"]
let
patients = patientList (getPatientsStatement connectionString)
providers = providerList (getProvidersStatement connectionString)
getEntries = getEntriesStatement connectionString
start <- getCurrentTime
mapM (\(count, patient) -> do
end <- getCurrentTime
let
entries = bucketBy2 entryMeasure entrySection $ patientEntries getEntries patient providers
elapsed = realToFrac (diffUTCTime end start) :: Double
results = getData patient entries measures
printf "\r%0.0f patients in %0.2f minutes at %0.2f patients per second" count (elapsed / 60) (count / elapsed)
output patient entries results
) $ zip ([1..]) patients
putStrLn "\nDone."
Jump to Line
Something went wrong with that request. Please try again.