claims-x12-dsl (empty) → 0.1.0.0
raw patch · 13 files changed
+1128/−0 lines, 13 filesdep +Decimaldep +QuickCheckdep +basesetup-changed
Dependencies added: Decimal, QuickCheck, base, claims-x12-dsl, containers, hspec, parsec, text, time
Files
- CHANGELOG.md +11/−0
- LICENSE +26/−0
- README.md +259/−0
- Setup.hs +2/−0
- app/Main.hs +47/−0
- claims-x12-dsl.cabal +91/−0
- src/Claims/Interpreter.hs +39/−0
- src/Claims/Parser.hs +228/−0
- src/Claims/Parser/AST.hs +39/−0
- src/Claims/Rules.hs +70/−0
- src/Claims/Types.hs +118/−0
- src/Lib.hs +17/−0
- test/Spec.hs +181/−0
+ CHANGELOG.md view
@@ -0,0 +1,11 @@+# Changelog for `claims-x12-dsl`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - YYYY-MM-DD
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright 2026 Author: Charles E. O'Riley++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,259 @@+# Healthcare Claims X12 Processing DSL++A Domain-Specific Language (DSL) for healthcare claims validation and X12 processing, implemented in Haskell.++## Overview++This project provides a type-safe, composable DSL for defining business rules for healthcare claims validation. It features both an internal DSL (embedded in Haskell) and an external DSL (text-based syntax for business analysts).++## Features++- **Type-Safe Internal DSL**: Uses GADTs to ensure rule correctness at compile time+- **Business-Friendly External DSL**: SQL-like syntax that non-programmers can read and write+- **Comprehensive Validation**: Support for amount checks, diagnosis codes, procedure codes, place of service, and claim types+- **Composable Rules**: Combine simple rules into complex validation logic using `AND`, `OR`, and `NOT`+- **Full Test Coverage**: Comprehensive test suite using Hspec++## Project Structure++```+claims-x12-dsl/+├── src/+│ ├── Claims/+│ │ ├── Types.hs # Core domain types and Rule GADT+│ │ ├── Interpreter.hs # Rule evaluation engine+│ │ ├── Rules.hs # Example business rules+│ │ ├── Parser.hs # External DSL parser (Parsec)+│ │ └── Parser/+│ │ └── AST.hs # Abstract syntax tree for external DSL+│ └── Lib.hs # Main library exports+├── app/+│ └── Main.hs # Example application+├── test/+│ └── Spec.hs # Test suite+├── examples/+│ └── sample-rules.dsl # Example external DSL rules+└── package.yaml # Project dependencies+```++## Getting Started++### Prerequisites++You'll need Stack installed. If you don't have it:++**macOS:**+```bash+curl -sSL https://get.haskellstack.org/ | sh+```++**Linux:**+```bash+curl -sSL https://get.haskellstack.org/ | sh+```++**Windows:**+Download the installer from [haskellstack.org](https://docs.haskellstack.org/en/stable/install_and_upgrade/)++### Installation++1. **Clone or navigate to the project:**+ ```bash+ cd /path/to/claims-x12-dsl+ ```++2. **Build the project:**+ ```bash+ stack build+ ```+ + This will:+ - Download and install the correct GHC version (9.6.6) if needed+ - Install all dependencies+ - Compile the library and executable+ - First build takes ~60 seconds; subsequent builds are much faster++3. **Verify the build:**+ ```bash+ stack test+ ```+ + You should see:+ ```+ 22 examples, 0 failures+ Finished in 0.0036 seconds+ ```++### Running the Application++**Run the example application:**+```bash+stack run+```++This validates a sample $75,000 inpatient claim and displays results:+```+Healthcare Claims X12 Processing DSL+====================================++Validating example claim:+Claim ID: "CLM001"+Amount: $75000.00+Type: Inpatient++Validation Results:+-------------------+Rule 1: FAIL - "Review Required: High value claim exceeds $50,000"+Rule 2: PASS+Rule 3: PASS+Rule 4: PASS+Rule 5: PASS+```++### Running Tests++**Run all tests:**+```bash+stack test+```++**Run tests with detailed output:**+```bash+stack test --test-arguments="--format=progress"+```++**Run tests with coverage:**+```bash+stack test --coverage+```++### Interactive Development++**Start a REPL (GHCi):**+```bash+stack ghci+```++Then you can interactively test the DSL:+```haskell+ghci> :load src/Claims/Types.hs+ghci> :load src/Claims/Interpreter.hs+ghci> import Data.Decimal+ghci> import Data.Time+-- Create a claim and test rules interactively+```++## Usage++### Internal DSL (Haskell)++```haskell+import Claims.Types+import Claims.Interpreter+import Data.Decimal (realFracToDecimal)+import Data.Time (fromGregorian)++-- Define a claim+claim = Claim+ { claimId = "CLM001"+ , patientId = "PAT12345"+ , providerId = "PRV98765"+ , serviceDate = fromGregorian 2025 1 5+ , totalAmount = realFracToDecimal 2 75000+ , diagnosisCodes = ["I21.0", "I25.10"]+ , procedureCodes = ["99223", "93000"]+ , placeOfService = "21"+ , claimType = Inpatient+ }++-- Define a rule+highValueRule :: Rule ValidationResult+highValueRule = + If (greaterThan 50000)+ (needsReview "High value claim exceeds $50,000")+ approve++-- Evaluate the rule+result = eval claim highValueRule+```++### External DSL (Business Analyst Syntax)++Create a rules file (e.g., `rules.dsl`):++```+RULE HighValueReview+DESCRIPTION "Flag high-value claims for manual review"+WHEN+ claim.amount > 50000+THEN+ REQUIRE_REVIEW "Claim exceeds high-value threshold"+END++RULE EmergencyRoomValidation+DESCRIPTION "Validate ER claims have appropriate diagnoses"+WHEN+ claim.place_of_service = "23" AND+ NOT (claim.has_diagnosis "S06" OR claim.has_diagnosis "I21")+THEN+ REJECT "Emergency room claim missing emergency diagnosis"+END+```++Parse and use the rules:++```haskell+import Claims.Parser++rulesText <- readFile "rules.dsl"+case parseRules rulesText of+ Left err -> print err+ Right parsedRules -> do+ let internalRules = map convertToInternalRule parsedRules+ let results = validateClaim claim internalRules+ print results+```++## Built-in Business Rules++The library includes several example business rules:++1. **High Value Claims Review**: Claims exceeding $50,000 require manual review+2. **Emergency Room Validation**: ER claims must have emergency diagnosis codes+3. **Inpatient Admission**: Inpatient claims must include admission procedure codes+4. **Complex Professional Claims**: Multi-condition validation for professional claims+5. **Outpatient Surgery Minimum**: Outpatient surgeries must meet minimum amounts++## External DSL Syntax++### Conditions++- Amount comparisons: `claim.amount > 50000`, `claim.amount BETWEEN 0 AND 100`+- Code checks: `claim.has_diagnosis "I21"`, `claim.has_procedure "99223"`+- Claim properties: `claim.type = "Inpatient"`, `claim.place_of_service = "23"`+- Logical operators: `AND`, `OR`, `NOT`++### Actions++- `APPROVE`: Automatically approve the claim+- `REJECT "message"`: Reject the claim with a reason+- `REQUIRE_REVIEW "message"`: Flag for manual review++## Dependencies++- **base**: Core Haskell library+- **text**: Efficient text handling+- **time**: Date/time support+- **Decimal**: Precise decimal arithmetic for currency+- **parsec**: Parser combinator library for external DSL+- **containers**: Data structures+- **hspec**: Testing framework+- **QuickCheck**: Property-based testing++## License++BSD-3-Clause++## Author++Based on the Healthcare Claims X12 Processing DSL specification.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Claims.Types+import Claims.Interpreter+import Claims.Rules+import Data.Time (fromGregorian)+import Data.Decimal (realFracToDecimal)++-- | Example claim from the requirements document+exampleClaim :: Claim+exampleClaim = Claim+ { claimId = "CLM001"+ , patientId = "PAT12345"+ , providerId = "PRV98765"+ , serviceDate = fromGregorian 2025 1 5+ , totalAmount = realFracToDecimal 2 (75000 :: Double)+ , diagnosisCodes = ["I21.0", "I25.10"]+ , procedureCodes = ["99223", "93000"]+ , placeOfService = "21"+ , claimType = Inpatient+ }++main :: IO ()+main = do+ putStrLn "Healthcare Claims X12 Processing DSL"+ putStrLn "===================================="+ putStrLn ""+ + putStrLn "Validating example claim:"+ putStrLn $ "Claim ID: " ++ show (claimId exampleClaim)+ putStrLn $ "Amount: $" ++ show (totalAmount exampleClaim)+ putStrLn $ "Type: " ++ show (claimType exampleClaim)+ putStrLn ""+ + let results = validateClaim exampleClaim allRules+ + putStrLn "Validation Results:"+ putStrLn "-------------------"+ mapM_ printResult $ zip [1..] results+ + where+ printResult (n, Valid) = + putStrLn $ "Rule " ++ show (n :: Int) ++ ": PASS"+ printResult (n, Invalid msg) = + putStrLn $ "Rule " ++ show (n :: Int) ++ ": FAIL - " ++ show msg
+ claims-x12-dsl.cabal view
@@ -0,0 +1,91 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.38.1.+--+-- see: https://github.com/sol/hpack++name: claims-x12-dsl+version: 0.1.0.0+synopsis: Type-safe DSL for healthcare claims validation and X12 processing+description: A type-safe, composable DSL for healthcare claims validation with both internal (Haskell) and external (text-based) syntax. Features GADT-based rules, comprehensive validation support, and business-friendly rule definitions.+category: Healthcare+homepage: https://github.com/nagashi/claims-x12-dsl#readme+bug-reports: https://github.com/nagashi/claims-x12-dsl/issues+author: Charles Ellis O'Riley Jr.+maintainer: ceoriley@gmail.com+copyright: 2026 Charles Ellis O'Riley Jr.+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/nagashi/claims-x12-dsl++library+ exposed-modules:+ Claims.Interpreter+ Claims.Parser+ Claims.Parser.AST+ Claims.Rules+ Claims.Types+ Lib+ other-modules:+ Paths_claims_x12_dsl+ autogen-modules:+ Paths_claims_x12_dsl+ hs-source-dirs:+ src+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+ build-depends:+ Decimal ==0.5.*+ , base >=4.7 && <5+ , containers >=0.6 && <0.8+ , parsec ==3.1.*+ , text >=1.2 && <2.2+ , time >=1.9 && <1.15+ default-language: Haskell2010++executable claims-x12-dsl-exe+ main-is: Main.hs+ other-modules:+ Paths_claims_x12_dsl+ autogen-modules:+ Paths_claims_x12_dsl+ hs-source-dirs:+ app+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ Decimal ==0.5.*+ , base >=4.7 && <5+ , claims-x12-dsl+ , containers >=0.6 && <0.8+ , parsec ==3.1.*+ , text >=1.2 && <2.2+ , time >=1.9 && <1.15+ default-language: Haskell2010++test-suite claims-x12-dsl-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_claims_x12_dsl+ autogen-modules:+ Paths_claims_x12_dsl+ hs-source-dirs:+ test+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ Decimal ==0.5.*+ , QuickCheck >=2.14 && <2.16+ , base >=4.7 && <5+ , claims-x12-dsl+ , containers >=0.6 && <0.8+ , hspec >=2.7 && <2.12+ , parsec ==3.1.*+ , text >=1.2 && <2.2+ , time >=1.9 && <1.15+ default-language: Haskell2010
+ src/Claims/Interpreter.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}++module Claims.Interpreter+ ( eval+ , validateClaim+ ) where++import Claims.Types++-- | Evaluate a rule against a claim+eval :: Claim -> Rule a -> a+eval claim rule = case rule of+ AmountGreaterThan amt -> totalAmount claim > amt+ AmountLessThan amt -> totalAmount claim < amt+ AmountBetween low high -> totalAmount claim >= low && totalAmount claim <= high+ + HasDiagnosisCode code -> code `elem` diagnosisCodes claim+ HasProcedureCode code -> code `elem` procedureCodes claim+ + IsClaimType ct -> claimType claim == ct+ PlaceOfServiceIs p -> placeOfService claim == p+ + And r1 r2 -> eval claim r1 && eval claim r2+ Or r1 r2 -> eval claim r1 || eval claim r2+ Not r -> not (eval claim r)+ + Reject msg -> Invalid msg+ Approve -> Valid+ RequireReview msg -> Invalid ("Review Required: " <> msg)+ + If cond thenRule elseRule ->+ if eval claim cond+ then eval claim thenRule+ else eval claim elseRule++-- | Validate a claim against a list of rules+validateClaim :: Claim -> [Rule ValidationResult] -> [ValidationResult]+validateClaim claim rules = map (eval claim) rules
+ src/Claims/Parser.hs view
@@ -0,0 +1,228 @@+{-# LANGUAGE OverloadedStrings #-}++module Claims.Parser+ ( parseRule+ , parseRules+ , convertToInternalRule+ ) where++import Claims.Parser.AST+import qualified Claims.Types as T+import Claims.Types (Rule, ClaimType(..), ValidationResult)+import Text.Parsec+import Text.Parsec.String (Parser)+import Text.Parsec.Expr (buildExpressionParser, Operator(..), Assoc(..))+import qualified Text.Parsec.Token as P+import Text.Parsec.Language (emptyDef)+import Data.Text (pack)+import Data.Decimal (realFracToDecimal)++-- Lexer definition+lexer :: P.TokenParser ()+lexer = P.makeTokenParser emptyDef+ { P.reservedNames = + [ "RULE", "DESCRIPTION", "WHEN", "THEN", "ELSE", "END"+ , "AND", "OR", "NOT", "BETWEEN"+ , "APPROVE", "REJECT", "REQUIRE_REVIEW"+ , "claim", "amount", "type", "place_of_service"+ , "has_diagnosis", "has_procedure"+ , "Inpatient", "Outpatient", "Professional"+ ]+ , P.reservedOpNames = [">", "<", "=", ">=", "<="]+ }++reserved :: String -> Parser ()+reserved = P.reserved lexer++reservedOp :: String -> Parser ()+reservedOp = P.reservedOp lexer++identifier :: Parser String+identifier = P.identifier lexer++stringLiteral :: Parser String+stringLiteral = P.stringLiteral lexer++float :: Parser Double+float = P.float lexer++natural :: Parser Integer+natural = P.natural lexer++whiteSpace :: Parser ()+whiteSpace = P.whiteSpace lexer++dot :: Parser String+dot = P.dot lexer++-- | Parse a complete rule+parseRule :: Parser ParsedRule+parseRule = do+ whiteSpace+ reserved "RULE"+ name <- identifier+ reserved "DESCRIPTION"+ desc <- stringLiteral+ reserved "WHEN"+ cond <- parseCondition+ reserved "THEN"+ act <- parseAction+ elseAct <- optionMaybe parseElseWhen+ reserved "END"+ return $ ParsedRule name desc cond act elseAct++-- | Parse ELSE WHEN clause+parseElseWhen :: Parser (Condition, Action)+parseElseWhen = do+ reserved "ELSE"+ reserved "WHEN"+ cond <- parseCondition+ reserved "THEN"+ act <- parseAction+ return (cond, act)++-- | Parse a condition expression+parseCondition :: Parser Condition+parseCondition = buildExpressionParser table term+ where+ table = + [ [Prefix (reserved "NOT" >> return NotCond)]+ , [Infix (reserved "AND" >> return AndCond) AssocLeft]+ , [Infix (reserved "OR" >> return OrCond) AssocLeft]+ ]+ + term = parens parseCondition+ <|> try parseAmountBetween+ <|> try parseAmountComparison+ <|> try parseHasDiagnosis+ <|> try parseHasProcedure+ <|> try parsePlaceOfService+ <|> try parseClaimType++parens :: Parser a -> Parser a+parens = P.parens lexer++-- | Parse amount comparison (e.g., claim.amount > 50000)+parseAmountComparison :: Parser Condition+parseAmountComparison = do+ reserved "claim"+ _ <- dot+ reserved "amount"+ op <- parseCompOp+ value <- try float <|> fmap fromInteger natural+ return $ CompareAmount op value++-- | Parse amount between (e.g., claim.amount BETWEEN 0 AND 100)+parseAmountBetween :: Parser Condition+parseAmountBetween = do+ reserved "claim"+ _ <- dot+ reserved "amount"+ reserved "BETWEEN"+ low <- try float <|> fmap fromInteger natural+ reserved "AND"+ high <- try float <|> fmap fromInteger natural+ return $ AmountBetween low high++-- | Parse has diagnosis code (e.g., claim.has_diagnosis "S06")+parseHasDiagnosis :: Parser Condition+parseHasDiagnosis = do+ reserved "claim"+ _ <- dot+ reserved "has_diagnosis"+ code <- stringLiteral+ return $ CheckDiagnosis code++-- | Parse has procedure code (e.g., claim.has_procedure "99221")+parseHasProcedure :: Parser Condition+parseHasProcedure = do+ reserved "claim"+ _ <- dot+ reserved "has_procedure"+ code <- stringLiteral+ return $ CheckProcedure code++-- | Parse place of service (e.g., claim.place_of_service = "23")+parsePlaceOfService :: Parser Condition+parsePlaceOfService = do+ reserved "claim"+ _ <- dot+ reserved "place_of_service"+ reservedOp "="+ pos <- stringLiteral+ return $ CheckPlaceOfService pos++-- | Parse claim type (e.g., claim.type = "Inpatient")+parseClaimType :: Parser Condition+parseClaimType = do+ reserved "claim"+ _ <- dot+ reserved "type"+ reservedOp "="+ ct <- stringLiteral+ return $ CheckClaimType ct++-- | Parse comparison operator+parseCompOp :: Parser CompOp+parseCompOp = + (reservedOp ">=" >> return Gte)+ <|> (reservedOp "<=" >> return Lte)+ <|> (reservedOp ">" >> return Gt)+ <|> (reservedOp "<" >> return Lt)+ <|> (reservedOp "=" >> return Eq)++-- | Parse an action+parseAction :: Parser Action+parseAction = + (reserved "APPROVE" >> return ApproveClaim)+ <|> (reserved "REJECT" >> RejectClaim <$> stringLiteral)+ <|> (reserved "REQUIRE_REVIEW" >> RequireReview <$> stringLiteral)++-- | Parse multiple rules from a file+parseRules :: String -> Either ParseError [ParsedRule]+parseRules input = parse (many parseRule <* eof) "" input++-- | Convert a parsed external DSL rule to an internal DSL rule+convertToInternalRule :: ParsedRule -> Rule ValidationResult+convertToInternalRule pr = + case elseAction pr of+ Nothing -> T.If (convertCondition (conditions pr)) (convertAction (action pr)) T.approve+ Just (elseCond, elseAct) -> + T.If (convertCondition (conditions pr)) + (convertAction (action pr))+ (T.If (convertCondition elseCond) (convertAction elseAct) T.approve)++-- | Convert a parsed condition to an internal rule condition+convertCondition :: Condition -> Rule Bool+convertCondition cond = case cond of+ CompareAmount op value -> + let amt = realFracToDecimal 2 value+ epsilon = realFracToDecimal 2 (0.01 :: Double)+ in case op of+ Gt -> T.greaterThan amt+ Lt -> T.lessThan amt+ Eq -> T.AmountGreaterThan amt `T.And` T.AmountLessThan (amt + epsilon)+ Gte -> T.greaterThan amt `T.Or` (T.AmountGreaterThan amt `T.And` T.AmountLessThan (amt + epsilon))+ Lte -> T.lessThan amt `T.Or` (T.AmountGreaterThan amt `T.And` T.AmountLessThan (amt + epsilon))+ AmountBetween low high -> T.between (realFracToDecimal 2 low) (realFracToDecimal 2 high)+ CheckDiagnosis code -> T.hasDx (pack code)+ CheckProcedure code -> T.hasPx (pack code)+ CheckPlaceOfService p -> T.pos (pack p)+ CheckClaimType ct -> T.isType (convertClaimType ct)+ AndCond c1 c2 -> convertCondition c1 `T.And` convertCondition c2+ OrCond c1 c2 -> convertCondition c1 `T.Or` convertCondition c2+ NotCond c -> T.Not (convertCondition c)++-- | Convert a parsed action to an internal rule action+convertAction :: Action -> Rule ValidationResult+convertAction act = case act of+ ApproveClaim -> T.approve+ RejectClaim msg -> T.reject (pack msg)+ RequireReview msg -> T.needsReview (pack msg)++-- | Convert a claim type string to ClaimType+convertClaimType :: String -> ClaimType+convertClaimType "Inpatient" = Inpatient+convertClaimType "Outpatient" = Outpatient+convertClaimType "Professional" = Professional+convertClaimType _ = Professional -- default
+ src/Claims/Parser/AST.hs view
@@ -0,0 +1,39 @@+module Claims.Parser.AST+ ( ParsedRule(..)+ , Condition(..)+ , Action(..)+ , CompOp(..)+ ) where++-- | A parsed rule from the external DSL+data ParsedRule = ParsedRule+ { ruleName :: String+ , ruleDescription :: String+ , conditions :: Condition+ , action :: Action+ , elseAction :: Maybe (Condition, Action)+ } deriving (Show, Eq)++-- | Condition expressions in the external DSL+data Condition+ = CompareAmount CompOp Double+ | AmountBetween Double Double+ | CheckDiagnosis String+ | CheckProcedure String+ | CheckPlaceOfService String+ | CheckClaimType String+ | AndCond Condition Condition+ | OrCond Condition Condition+ | NotCond Condition+ deriving (Show, Eq)++-- | Comparison operators+data CompOp = Gt | Lt | Eq | Gte | Lte+ deriving (Show, Eq)++-- | Actions that can be taken on a claim+data Action+ = RejectClaim String+ | ApproveClaim+ | RequireReview String+ deriving (Show, Eq)
+ src/Claims/Rules.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}++module Claims.Rules+ ( -- * Business Rules+ highValueClaimRule+ , erClaimRule+ , inpatientRule+ , complexRule+ , outpatientSurgeryRule+ , allRules+ ) where++import Claims.Types++-- | Rule 1: High-Value Claims Review+-- Business Logic: Any claim exceeding $50,000 requires manual review+highValueClaimRule :: Rule ValidationResult+highValueClaimRule = + If (greaterThan 50000)+ (needsReview "High value claim exceeds $50,000")+ approve++-- | Rule 2: Emergency Room Validation+-- Business Logic: Emergency room claims (POS 23) must have appropriate +-- emergency diagnosis codes (head injury S06 or heart attack I21)+erClaimRule :: Rule ValidationResult+erClaimRule =+ If (pos "23" `And` Not (hasDx "S06" `Or` hasDx "I21"))+ (reject "ER claim without emergency diagnosis code")+ approve++-- | Rule 3: Inpatient Admission Codes+-- Business Logic: Inpatient claims must include one of the standard +-- admission procedure codes+inpatientRule :: Rule ValidationResult+inpatientRule =+ If (isType Inpatient `And` Not (hasPx "99221" `Or` hasPx "99222" `Or` hasPx "99223"))+ (reject "Inpatient claim missing admission procedure code")+ approve++-- | Rule 4: Complex Combination Rule+-- Business Logic: Professional claims over $10,000 in office settings +-- are handled differently based on whether they're preventive care +-- (which should be rejected) or other services (which need review)+complexRule :: Rule ValidationResult+complexRule =+ If (isType Professional `And` greaterThan 10000 `And` pos "11")+ (If (hasDx "Z00.00" `Or` hasDx "Z00.01")+ (reject "Preventive care should not exceed $10,000 in office setting")+ (needsReview "High-value professional claim in office"))+ approve++-- | Rule 5: Outpatient Surgery Validation+-- Business Logic: Outpatient surgical procedures (POS 24) should not +-- have amounts below $100, which likely indicates a billing error+outpatientSurgeryRule :: Rule ValidationResult+outpatientSurgeryRule =+ If (isType Outpatient `And` pos "24" `And` between 0 100)+ (reject "Outpatient surgical claim amount too low")+ approve++-- | All business rules combined+allRules :: [Rule ValidationResult]+allRules = + [ highValueClaimRule+ , erClaimRule+ , inpatientRule+ , complexRule+ , outpatientSurgeryRule+ ]
+ src/Claims/Types.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}++module Claims.Types+ ( -- * Core Domain Types+ Claim(..)+ , ClaimType(..)+ , ValidationResult(..)+ -- * Rule Types+ , Rule(..)+ -- * Smart Constructors+ , greaterThan+ , lessThan+ , between+ , hasDx+ , hasPx+ , isType+ , pos+ , reject+ , approve+ , needsReview+ ) where++import Data.Text (Text)+import Data.Time (Day)+import Data.Decimal (Decimal)++-- | Represents a healthcare claim+data Claim = Claim+ { claimId :: Text+ , patientId :: Text+ , providerId :: Text+ , serviceDate :: Day+ , totalAmount :: Decimal+ , diagnosisCodes :: [Text]+ , procedureCodes :: [Text]+ , placeOfService :: Text+ , claimType :: ClaimType+ } deriving (Show, Eq)++-- | Types of healthcare claims+data ClaimType + = Inpatient + | Outpatient + | Professional+ deriving (Show, Eq)++-- | Result of claim validation+data ValidationResult + = Valid + | Invalid Text+ deriving (Show, Eq)++-- | Rule expression GADT for type-safe DSL+data Rule a where+ -- Predicates+ AmountGreaterThan :: Decimal -> Rule Bool+ AmountLessThan :: Decimal -> Rule Bool+ AmountBetween :: Decimal -> Decimal -> Rule Bool+ + HasDiagnosisCode :: Text -> Rule Bool+ HasProcedureCode :: Text -> Rule Bool+ + IsClaimType :: ClaimType -> Rule Bool+ PlaceOfServiceIs :: Text -> Rule Bool+ + -- Logical operators+ And :: Rule Bool -> Rule Bool -> Rule Bool+ Or :: Rule Bool -> Rule Bool -> Rule Bool+ Not :: Rule Bool -> Rule Bool+ + -- Actions+ Reject :: Text -> Rule ValidationResult+ Approve :: Rule ValidationResult+ RequireReview :: Text -> Rule ValidationResult+ + -- Control flow+ If :: Rule Bool -> Rule ValidationResult -> Rule ValidationResult -> Rule ValidationResult++-- | Smart constructor for amount greater than+greaterThan :: Decimal -> Rule Bool+greaterThan = AmountGreaterThan++-- | Smart constructor for amount less than+lessThan :: Decimal -> Rule Bool+lessThan = AmountLessThan++-- | Smart constructor for amount between range+between :: Decimal -> Decimal -> Rule Bool+between = AmountBetween++-- | Smart constructor for has diagnosis code+hasDx :: Text -> Rule Bool+hasDx = HasDiagnosisCode++-- | Smart constructor for has procedure code+hasPx :: Text -> Rule Bool+hasPx = HasProcedureCode++-- | Smart constructor for claim type check+isType :: ClaimType -> Rule Bool+isType = IsClaimType++-- | Smart constructor for place of service check+pos :: Text -> Rule Bool+pos = PlaceOfServiceIs++-- | Smart constructor for reject action+reject :: Text -> Rule ValidationResult+reject = Reject++-- | Smart constructor for approve action+approve :: Rule ValidationResult+approve = Approve++-- | Smart constructor for review action+needsReview :: Text -> Rule ValidationResult+needsReview = RequireReview
+ src/Lib.hs view
@@ -0,0 +1,17 @@+module Lib+ ( -- * Core Types+ module Claims.Types+ -- * Interpreter+ , module Claims.Interpreter+ -- * Rules+ , module Claims.Rules+ -- * Parser+ , parseRule+ , parseRules+ , convertToInternalRule+ ) where++import Claims.Types+import Claims.Interpreter+import Claims.Rules+import Claims.Parser (parseRule, parseRules, convertToInternalRule)
+ test/Spec.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE OverloadedStrings #-}++import Test.Hspec+import Test.QuickCheck+import Claims.Types+import Claims.Interpreter+import Claims.Rules+import Claims.Parser+import Claims.Parser.AST+import Data.Time (fromGregorian)+import Data.Decimal (realFracToDecimal)+import Data.Text (Text)++main :: IO ()+main = hspec $ do+ describe "Claims.Interpreter" $ do+ it "evaluates amount greater than correctly" $ do+ let claim = testClaim { totalAmount = realFracToDecimal 2 60000 }+ eval claim (greaterThan 50000) `shouldBe` True+ eval claim (greaterThan 70000) `shouldBe` False+ + it "evaluates amount less than correctly" $ do+ let claim = testClaim { totalAmount = realFracToDecimal 2 40000 }+ eval claim (lessThan 50000) `shouldBe` True+ eval claim (lessThan 30000) `shouldBe` False+ + it "evaluates amount between correctly" $ do+ let claim = testClaim { totalAmount = realFracToDecimal 2 50 }+ eval claim (between 0 100) `shouldBe` True+ eval claim (between 60 100) `shouldBe` False+ + it "evaluates diagnosis code check correctly" $ do+ let claim = testClaim { diagnosisCodes = ["I21.0", "I25.10"] }+ eval claim (hasDx "I21.0") `shouldBe` True+ eval claim (hasDx "S06") `shouldBe` False+ + it "evaluates procedure code check correctly" $ do+ let claim = testClaim { procedureCodes = ["99223", "93000"] }+ eval claim (hasPx "99223") `shouldBe` True+ eval claim (hasPx "99221") `shouldBe` False+ + it "evaluates claim type correctly" $ do+ let claim = testClaim { claimType = Inpatient }+ eval claim (isType Inpatient) `shouldBe` True+ eval claim (isType Outpatient) `shouldBe` False+ + it "evaluates place of service correctly" $ do+ let claim = testClaim { placeOfService = "21" }+ eval claim (pos "21") `shouldBe` True+ eval claim (pos "23") `shouldBe` False+ + it "evaluates AND correctly" $ do+ let claim = testClaim { totalAmount = realFracToDecimal 2 60000, claimType = Inpatient }+ eval claim (greaterThan 50000 `And` isType Inpatient) `shouldBe` True+ eval claim (greaterThan 50000 `And` isType Outpatient) `shouldBe` False+ + it "evaluates OR correctly" $ do+ let claim = testClaim { claimType = Inpatient }+ eval claim (isType Inpatient `Or` isType Outpatient) `shouldBe` True+ eval claim (isType Professional `Or` isType Outpatient) `shouldBe` False+ + it "evaluates NOT correctly" $ do+ let claim = testClaim { claimType = Inpatient }+ eval claim (Not (isType Outpatient)) `shouldBe` True+ eval claim (Not (isType Inpatient)) `shouldBe` False+ + describe "Claims.Rules" $ do+ it "highValueClaimRule triggers for claims over $50,000" $ do+ let claim = testClaim { totalAmount = realFracToDecimal 2 75000 }+ eval claim highValueClaimRule `shouldBe` Invalid "Review Required: High value claim exceeds $50,000"+ + it "highValueClaimRule approves claims under $50,000" $ do+ let claim = testClaim { totalAmount = realFracToDecimal 2 40000 }+ eval claim highValueClaimRule `shouldBe` Valid+ + it "erClaimRule rejects ER claims without emergency diagnosis" $ do+ let claim = testClaim { placeOfService = "23", diagnosisCodes = ["Z00.00"] }+ eval claim erClaimRule `shouldBe` Invalid "ER claim without emergency diagnosis code"+ + it "erClaimRule approves ER claims with emergency diagnosis" $ do+ let claim = testClaim { placeOfService = "23", diagnosisCodes = ["I21"] }+ eval claim erClaimRule `shouldBe` Valid+ + it "inpatientRule rejects inpatient claims without admission code" $ do+ let claim = testClaim { claimType = Inpatient, procedureCodes = ["93000"] }+ eval claim inpatientRule `shouldBe` Invalid "Inpatient claim missing admission procedure code"+ + it "inpatientRule approves inpatient claims with admission code" $ do+ let claim = testClaim { claimType = Inpatient, procedureCodes = ["99223", "93000"] }+ eval claim inpatientRule `shouldBe` Valid+ + it "outpatientSurgeryRule rejects low-value outpatient surgery claims" $ do+ let claim = testClaim { claimType = Outpatient, placeOfService = "24", totalAmount = realFracToDecimal 2 50 }+ eval claim outpatientSurgeryRule `shouldBe` Invalid "Outpatient surgical claim amount too low"+ + it "outpatientSurgeryRule approves normal outpatient surgery claims" $ do+ let claim = testClaim { claimType = Outpatient, placeOfService = "24", totalAmount = realFracToDecimal 2 500 }+ eval claim outpatientSurgeryRule `shouldBe` Valid+ + describe "Claims.Parser" $ do+ it "parses a simple APPROVE rule" $ do+ let input = unlines+ [ "RULE SimpleApprove"+ , "DESCRIPTION \"Always approve\""+ , "WHEN"+ , " claim.amount < 1000"+ , "THEN"+ , " APPROVE"+ , "END"+ ]+ case parseRules input of+ Left err -> expectationFailure $ "Parse error: " ++ show err+ Right [rule] -> do+ Claims.Parser.AST.ruleName rule `shouldBe` "SimpleApprove"+ ruleDescription rule `shouldBe` "Always approve"+ Claims.Parser.AST.action rule `shouldBe` ApproveClaim+ Right _ -> expectationFailure "Expected exactly one rule"+ + it "parses a REJECT rule with amount comparison" $ do+ let input = unlines+ [ "RULE HighValueReject"+ , "DESCRIPTION \"Reject high value claims\""+ , "WHEN"+ , " claim.amount > 100000"+ , "THEN"+ , " REJECT \"Amount too high\""+ , "END"+ ]+ case parseRules input of+ Left err -> expectationFailure $ "Parse error: " ++ show err+ Right [rule] -> do+ Claims.Parser.AST.action rule `shouldBe` RejectClaim "Amount too high"+ Right _ -> expectationFailure "Expected exactly one rule"+ + it "parses a rule with AND condition" $ do+ let input = unlines+ [ "RULE ComplexRule"+ , "DESCRIPTION \"Complex condition\""+ , "WHEN"+ , " claim.amount > 5000 AND claim.place_of_service = \"23\""+ , "THEN"+ , " REQUIRE_REVIEW \"Needs review\""+ , "END"+ ]+ case parseRules input of+ Left err -> expectationFailure $ "Parse error: " ++ show err+ Right [rule] -> do+ case Claims.Parser.AST.conditions rule of+ AndCond _ _ -> return ()+ _ -> expectationFailure "Expected AND condition"+ Right _ -> expectationFailure "Expected exactly one rule"+ + it "parses a rule with diagnosis code check" $ do+ let input = unlines+ [ "RULE DiagnosisCheck"+ , "DESCRIPTION \"Check diagnosis\""+ , "WHEN"+ , " claim.has_diagnosis \"I21\""+ , "THEN"+ , " APPROVE"+ , "END"+ ]+ case parseRules input of+ Left err -> expectationFailure $ "Parse error: " ++ show err+ Right [rule] -> do+ Claims.Parser.AST.conditions rule `shouldBe` CheckDiagnosis "I21"+ Right _ -> expectationFailure "Expected exactly one rule"++-- | Test claim helper+testClaim :: Claim+testClaim = Claim+ { claimId = "TEST001"+ , patientId = "PAT001"+ , providerId = "PRV001"+ , serviceDate = fromGregorian 2025 1 1+ , totalAmount = realFracToDecimal 2 1000+ , diagnosisCodes = []+ , procedureCodes = []+ , placeOfService = "11"+ , claimType = Professional+ }