{-# 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 :: Rule ValidationResult
highValueClaimRule = 
  Rule Bool
-> Rule ValidationResult
-> Rule ValidationResult
-> Rule ValidationResult
If (Decimal -> Rule Bool
greaterThan Decimal
50000)
    (Text -> Rule ValidationResult
needsReview Text
"High value claim exceeds $50,000")
    Rule ValidationResult
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 :: Rule ValidationResult
erClaimRule =
  Rule Bool
-> Rule ValidationResult
-> Rule ValidationResult
-> Rule ValidationResult
If (Text -> Rule Bool
pos Text
"23" Rule Bool -> Rule Bool -> Rule Bool
`And` Rule Bool -> Rule Bool
Not (Text -> Rule Bool
hasDx Text
"S06" Rule Bool -> Rule Bool -> Rule Bool
`Or` Text -> Rule Bool
hasDx Text
"I21"))
    (Text -> Rule ValidationResult
reject Text
"ER claim without emergency diagnosis code")
    Rule ValidationResult
approve

-- | Rule 3: Inpatient Admission Codes
-- Business Logic: Inpatient claims must include one of the standard 
-- admission procedure codes
inpatientRule :: Rule ValidationResult
inpatientRule :: Rule ValidationResult
inpatientRule =
  Rule Bool
-> Rule ValidationResult
-> Rule ValidationResult
-> Rule ValidationResult
If (ClaimType -> Rule Bool
isType ClaimType
Inpatient Rule Bool -> Rule Bool -> Rule Bool
`And` Rule Bool -> Rule Bool
Not (Text -> Rule Bool
hasPx Text
"99221" Rule Bool -> Rule Bool -> Rule Bool
`Or` Text -> Rule Bool
hasPx Text
"99222" Rule Bool -> Rule Bool -> Rule Bool
`Or` Text -> Rule Bool
hasPx Text
"99223"))
    (Text -> Rule ValidationResult
reject Text
"Inpatient claim missing admission procedure code")
    Rule ValidationResult
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 :: Rule ValidationResult
complexRule =
  Rule Bool
-> Rule ValidationResult
-> Rule ValidationResult
-> Rule ValidationResult
If (ClaimType -> Rule Bool
isType ClaimType
Professional Rule Bool -> Rule Bool -> Rule Bool
`And` Decimal -> Rule Bool
greaterThan Decimal
10000 Rule Bool -> Rule Bool -> Rule Bool
`And` Text -> Rule Bool
pos Text
"11")
    (Rule Bool
-> Rule ValidationResult
-> Rule ValidationResult
-> Rule ValidationResult
If (Text -> Rule Bool
hasDx Text
"Z00.00" Rule Bool -> Rule Bool -> Rule Bool
`Or` Text -> Rule Bool
hasDx Text
"Z00.01")
      (Text -> Rule ValidationResult
reject Text
"Preventive care should not exceed $10,000 in office setting")
      (Text -> Rule ValidationResult
needsReview Text
"High-value professional claim in office"))
    Rule ValidationResult
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 :: Rule ValidationResult
outpatientSurgeryRule =
  Rule Bool
-> Rule ValidationResult
-> Rule ValidationResult
-> Rule ValidationResult
If (ClaimType -> Rule Bool
isType ClaimType
Outpatient Rule Bool -> Rule Bool -> Rule Bool
`And` Text -> Rule Bool
pos Text
"24" Rule Bool -> Rule Bool -> Rule Bool
`And` Decimal -> Decimal -> Rule Bool
between Decimal
0 Decimal
100)
    (Text -> Rule ValidationResult
reject Text
"Outpatient surgical claim amount too low")
    Rule ValidationResult
approve

-- | All business rules combined
allRules :: [Rule ValidationResult]
allRules :: [Rule ValidationResult]
allRules = 
  [ Rule ValidationResult
highValueClaimRule
  , Rule ValidationResult
erClaimRule
  , Rule ValidationResult
inpatientRule
  , Rule ValidationResult
complexRule
  , Rule ValidationResult
outpatientSurgeryRule
  ]