{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}

module Tax.Canada.Province.ON.ON428.FieldNames (on428Fields) where

import Data.Fixed (Centi)
import Rank2 qualified

import Tax.Canada.Province.ON.ON428.Types
import Tax.Canada.Province.ON.ON428.Types qualified as HealthPremiumBracket (HealthPremiumBracket(..))
import Tax.Canada.Shared (BaseCredit(..), MedicalExpenses(..), TaxIncomeBracket (..), subCalculationFields)
import Tax.FDF (Entry (Count, Constant, Amount, Percent), FieldConst (Field, NoField), within)

on428Fields :: ON428 FieldConst
on428Fields = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"form1" (forall {a}. FieldConst a -> FieldConst a)
-> ON428 FieldConst -> ON428 FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> ON428 p -> ON428 q
Rank2.<$> ON428 {
   $sel:page1:ON428 :: Page1 FieldConst
page1 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page1" (forall {a}. FieldConst a -> FieldConst a)
-> Page1 FieldConst -> Page1 FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> Page1 p -> Page1 q
Rank2.<$> Page1 FieldConst
page1Fields,
   $sel:page2:ON428 :: Page2 FieldConst
page2 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page2" (forall {a}. FieldConst a -> FieldConst a)
-> Page2 FieldConst -> Page2 FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> Page2 p -> Page2 q
Rank2.<$> Page2 FieldConst
page2Fields,
   $sel:page3:ON428 :: Page3 FieldConst
page3 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page3" (forall {a}. FieldConst a -> FieldConst a)
-> Page3 FieldConst -> Page3 FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> Page3 p -> Page3 q
Rank2.<$> Page3 FieldConst
page3Fields,
   $sel:page4:ON428 :: Page4 FieldConst
page4 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Page4" (forall {a}. FieldConst a -> FieldConst a)
-> Page4 FieldConst -> Page4 FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> Page4 p -> Page4 q
Rank2.<$> Page4 FieldConst
page4Fields}


page1Fields :: Page1 FieldConst
page1Fields = Page1 {
   $sel:line1:Page1 :: FieldConst Centi
line1 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line1", Text
"Amount"] Entry Centi
Amount,
   $sel:partA:Page1 :: Page1PartA FieldConst
partA = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Chart" (forall {a}. FieldConst a -> FieldConst a)
-> Page1PartA FieldConst -> Page1PartA FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> Page1PartA p -> Page1PartA q
Rank2.<$> Page1PartA FieldConst
page1PartAFields,
   $sel:partB:Page1 :: Page1PartB FieldConst
partB = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Part_B" (forall {a}. FieldConst a -> FieldConst a)
-> Page1PartB FieldConst -> Page1PartB FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> Page1PartB p -> Page1PartB q
Rank2.<$> Page1PartB FieldConst
page1PartBFields}

page1PartAFields :: Page1PartA FieldConst
page1PartAFields = Page1PartA {
   $sel:column1:Page1PartA :: TaxIncomeBracket FieldConst
column1 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Column1" (forall {a}. FieldConst a -> FieldConst a)
-> TaxIncomeBracket FieldConst -> TaxIncomeBracket FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> TaxIncomeBracket p -> TaxIncomeBracket q
Rank2.<$> Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields Centi
0 Rational
0.0505 Centi
0,
   $sel:column2:Page1PartA :: TaxIncomeBracket FieldConst
column2 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Column2" (forall {a}. FieldConst a -> FieldConst a)
-> TaxIncomeBracket FieldConst -> TaxIncomeBracket FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> TaxIncomeBracket p -> TaxIncomeBracket q
Rank2.<$> Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields Centi
49_231.00 Rational
0.0915 Centi
2_486.17,
   $sel:column3:Page1PartA :: TaxIncomeBracket FieldConst
column3 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Column3" (forall {a}. FieldConst a -> FieldConst a)
-> TaxIncomeBracket FieldConst -> TaxIncomeBracket FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> TaxIncomeBracket p -> TaxIncomeBracket q
Rank2.<$> Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields Centi
98_463.00 Rational
0.1116 Centi
6_990.89,
   $sel:column4:Page1PartA :: TaxIncomeBracket FieldConst
column4 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Column4" (forall {a}. FieldConst a -> FieldConst a)
-> TaxIncomeBracket FieldConst -> TaxIncomeBracket FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> TaxIncomeBracket p -> TaxIncomeBracket q
Rank2.<$> Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields Centi
150_000.00 Rational
0.1216 Centi
12_742.42,
   $sel:column5:Page1PartA :: TaxIncomeBracket FieldConst
column5 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Column5" (forall {a}. FieldConst a -> FieldConst a)
-> TaxIncomeBracket FieldConst -> TaxIncomeBracket FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> TaxIncomeBracket p -> TaxIncomeBracket q
Rank2.<$> Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields Centi
220_000.00 Rational
0.1316 Centi
21_254.42}

taxIncomeBracketFields :: Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields :: Centi -> Rational -> Centi -> TaxIncomeBracket FieldConst
taxIncomeBracketFields Centi
threshold Rational
rate Centi
baseTax = TaxIncomeBracket {
   $sel:income:TaxIncomeBracket :: FieldConst Centi
income = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line2", Text
"Amount"] Entry Centi
Amount,
   $sel:threshold:TaxIncomeBracket :: FieldConst Centi
threshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line3", Text
"Amount"] (Entry Centi -> FieldConst Centi)
-> Entry Centi -> FieldConst Centi
forall a b. (a -> b) -> a -> b
$ Centi -> Entry Centi -> Entry Centi
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Centi
threshold Entry Centi
Amount,
   $sel:overThreshold:TaxIncomeBracket :: FieldConst Centi
overThreshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line4", Text
"Amount"] Entry Centi
Amount,
   $sel:rate:TaxIncomeBracket :: FieldConst Rational
rate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line5", Text
"Percent"] (Entry Rational -> FieldConst Rational)
-> Entry Rational -> FieldConst Rational
forall a b. (a -> b) -> a -> b
$ Rational -> Entry Rational -> Entry Rational
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Rational
rate Entry Rational
Percent,
   $sel:timesRate:TaxIncomeBracket :: FieldConst Centi
timesRate = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line6", Text
"Amount"] Entry Centi
Amount,
   $sel:baseTax:TaxIncomeBracket :: FieldConst Centi
baseTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line7", Text
"Amount"] (Entry Centi -> FieldConst Centi)
-> Entry Centi -> FieldConst Centi
forall a b. (a -> b) -> a -> b
$ Centi -> Entry Centi -> Entry Centi
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Centi
baseTax Entry Centi
Amount,
   $sel:equalsTax:TaxIncomeBracket :: FieldConst Centi
equalsTax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line8", Text
"Amount"] Entry Centi
Amount}

page1PartBFields :: Page1PartB FieldConst
page1PartBFields = Page1PartB {
   $sel:line9_basic:Page1PartB :: FieldConst Centi
line9_basic = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line9", Text
"Amount"] Entry Centi
Amount,
   $sel:line10_age:Page1PartB :: FieldConst Centi
line10_age = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line10", Text
"Amount"] Entry Centi
Amount,
   $sel:spouseAmount:Page1PartB :: BaseCredit FieldConst
spouseAmount = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Spouse-Amount" (forall {a}. FieldConst a -> FieldConst a)
-> BaseCredit FieldConst -> BaseCredit FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> BaseCredit p -> BaseCredit q
Rank2.<$> BaseCredit{
       $sel:baseAmount:BaseCredit :: FieldConst Centi
baseAmount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line11", Text
"Amount"] (Entry Centi -> FieldConst Centi)
-> Entry Centi -> FieldConst Centi
forall a b. (a -> b) -> a -> b
$ Centi -> Entry Centi -> Entry Centi
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Centi
11_082 Entry Centi
Amount,
       $sel:reduction:BaseCredit :: FieldConst Centi
reduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line12", Text
"Amount"] Entry Centi
Amount,
       $sel:difference:BaseCredit :: FieldConst Centi
difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line13", Text
"Amount1"] Entry Centi
Amount,
       $sel:cont:BaseCredit :: FieldConst Centi
cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line13", Text
"Amount2"] Entry Centi
Amount},
   $sel:dependantAmount:Page1PartB :: BaseCredit FieldConst
dependantAmount = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Eligible-Dependant" (forall {a}. FieldConst a -> FieldConst a)
-> BaseCredit FieldConst -> BaseCredit FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> BaseCredit p -> BaseCredit q
Rank2.<$> BaseCredit{
       $sel:baseAmount:BaseCredit :: FieldConst Centi
baseAmount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line14", Text
"Amount"] (Entry Centi -> FieldConst Centi)
-> Entry Centi -> FieldConst Centi
forall a b. (a -> b) -> a -> b
$ Centi -> Entry Centi -> Entry Centi
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Centi
11_082 Entry Centi
Amount,
       $sel:reduction:BaseCredit :: FieldConst Centi
reduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line15", Text
"Amount"] Entry Centi
Amount,
       $sel:difference:BaseCredit :: FieldConst Centi
difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line16", Text
"Amount1"] Entry Centi
Amount,
       $sel:cont:BaseCredit :: FieldConst Centi
cont = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line16", Text
"Amount2"] Entry Centi
Amount},
   $sel:line17_caregiver:Page1PartB :: FieldConst Centi
line17_caregiver = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line17", Text
"Amount"] Entry Centi
Amount,
   $sel:line18:Page1PartB :: FieldConst Centi
line18 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line18", Text
"Amount"] Entry Centi
Amount,
   $sel:line19_cppQpp:Page1PartB :: FieldConst Centi
line19_cppQpp = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"CPP-QPP", Text
"Line19", Text
"Amount"] Entry Centi
Amount,
   $sel:line20_cppQpp:Page1PartB :: FieldConst Centi
line20_cppQpp = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"CPP-QPP", Text
"Line20", Text
"Amount"] Entry Centi
Amount,
   $sel:line21_employmentInsurance:Page1PartB :: FieldConst Centi
line21_employmentInsurance = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Employment-Insurance", Text
"Line21", Text
"Amount"] Entry Centi
Amount,
   $sel:line22_employmentInsurance:Page1PartB :: FieldConst Centi
line22_employmentInsurance = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Employment-Insurance", Text
"Line22", Text
"Amount"] Entry Centi
Amount,
   $sel:line23_adoption:Page1PartB :: FieldConst Centi
line23_adoption = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line23", Text
"Amount"] Entry Centi
Amount,
   $sel:line24_sum:Page1PartB :: SubCalculation FieldConst
line24_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line24" [Text
"Amount1"] [Text
"Amount2"],
   $sel:line25:Page1PartB :: FieldConst Centi
line25 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line25", Text
"Amount"] Entry Centi
Amount}

page2Fields :: Page2 FieldConst
page2Fields = Page2 {
  $sel:partB:Page2 :: Page2PartB FieldConst
partB = Page2PartB FieldConst
page2PartBFields,
  $sel:partC:Page2 :: Page2PartC FieldConst
partC = Page2PartC FieldConst
page2PartCFields}

page2PartBFields :: Page2PartB FieldConst
page2PartBFields = Page2PartB {
   $sel:line26:Page2PartB :: FieldConst Centi
line26 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line26", Text
"Amount"] Entry Centi
Amount,
   $sel:line27_pension:Page2PartB :: FieldConst Centi
line27_pension = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line27", Text
"Amount"] Entry Centi
Amount,
   $sel:line28:Page2PartB :: FieldConst Centi
line28 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line28", Text
"Amount"] Entry Centi
Amount,
   $sel:line29_disability:Page2PartB :: FieldConst Centi
line29_disability = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line29", Text
"Amount"] Entry Centi
Amount,
   $sel:line30:Page2PartB :: FieldConst Centi
line30 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line30", Text
"Amount"] Entry Centi
Amount,
   $sel:line31:Page2PartB :: FieldConst Centi
line31 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line31", Text
"Amount"] Entry Centi
Amount,
   $sel:line32_interest:Page2PartB :: FieldConst Centi
line32_interest = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line32", Text
"Amount"] Entry Centi
Amount,
   $sel:line33_education:Page2PartB :: FieldConst Centi
line33_education = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line33", Text
"Amount"] Entry Centi
Amount,
   $sel:line34_transferred:Page2PartB :: FieldConst Centi
line34_transferred = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line34", Text
"Amount"] Entry Centi
Amount,
   $sel:line35:Page2PartB :: FieldConst Centi
line35 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line35", Text
"Amount"] Entry Centi
Amount,
   $sel:medicalExpenses:Page2PartB :: MedicalExpenses FieldConst
medicalExpenses = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Medical-Expenses" (forall {a}. FieldConst a -> FieldConst a)
-> MedicalExpenses FieldConst -> MedicalExpenses FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> MedicalExpenses p -> MedicalExpenses q
Rank2.<$> MedicalExpenses FieldConst
medicalExpensesFields,
   $sel:line42:Page2PartB :: FieldConst Centi
line42 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line42", Text
"Amount"] Entry Centi
Amount,
   $sel:line43_sum:Page2PartB :: SubCalculation FieldConst
line43_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line43" [Text
"Amount1"] [Text
"Amount2"],
   $sel:line44:Page2PartB :: FieldConst Centi
line44 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line44", Text
"Amount"] Entry Centi
Amount,
   $sel:line45_rate:Page2PartB :: FieldConst Rational
line45_rate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line45", Text
"Percent_ReadOnly"] (Entry Rational -> FieldConst Rational)
-> Entry Rational -> FieldConst Rational
forall a b. (a -> b) -> a -> b
$ Rational -> Entry Rational -> Entry Rational
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Rational
0.0505 Entry Rational
Percent,
   $sel:line46_fraction:Page2PartB :: FieldConst Centi
line46_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line46", Text
"Amount"] Entry Centi
Amount,
   $sel:donations:Page2PartB :: Donations FieldConst
donations = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Donations" (forall {a}. FieldConst a -> FieldConst a)
-> Donations FieldConst -> Donations FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> Donations p -> Donations q
Rank2.<$> Donations FieldConst
donationsFields,
   $sel:line50:Page2PartB :: FieldConst Centi
line50 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line50", Text
"Amount"] Entry Centi
Amount}

medicalExpensesFields :: MedicalExpenses FieldConst
medicalExpensesFields = MedicalExpenses {
   $sel:expenses:MedicalExpenses :: FieldConst Centi
expenses = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line36", Text
"Amount"] Entry Centi
Amount,
   $sel:netIncome:MedicalExpenses :: FieldConst Centi
netIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line37", Text
"Amount"] Entry Centi
Amount,
   $sel:incomeRate:MedicalExpenses :: FieldConst Rational
incomeRate = [Text] -> Entry Rational -> FieldConst Rational
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line38", Text
"Percent_ReadOnly"] (Entry Rational -> FieldConst Rational)
-> Entry Rational -> FieldConst Rational
forall a b. (a -> b) -> a -> b
$ Rational -> Entry Rational -> Entry Rational
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Rational
0.03 Entry Rational
Percent,
   $sel:fraction:MedicalExpenses :: FieldConst Centi
fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line39", Text
"Amount"] Entry Centi
Amount,
   $sel:lesser:MedicalExpenses :: FieldConst Centi
lesser = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line40", Text
"Amount"] Entry Centi
Amount,
   $sel:difference:MedicalExpenses :: FieldConst Centi
difference = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line41", Text
"Amount"] Entry Centi
Amount}

donationsFields :: Donations FieldConst
donationsFields = Donations {
   $sel:line47_base:Donations :: FieldConst Centi
line47_base = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line47", Text
"Amount1"] Entry Centi
Amount,
   $sel:line47_fraction:Donations :: FieldConst Centi
line47_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line47", Text
"Amount2"] Entry Centi
Amount,
   $sel:line48_base:Donations :: FieldConst Centi
line48_base = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line48", Text
"Amount1"] Entry Centi
Amount,
   $sel:line48_fraction:Donations :: FieldConst Centi
line48_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line48", Text
"Amount2"] Entry Centi
Amount,
   $sel:line49_sum:Donations :: SubCalculation FieldConst
line49_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line49" [Text
"Amount1"] [Text
"Amount2"]}

page2PartCFields :: Page2PartC FieldConst
page2PartCFields = Page2PartC {
   $sel:line51_tax:Page2PartC :: FieldConst Centi
line51_tax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line51", Text
"Amount"] Entry Centi
Amount,
   $sel:line52_credits:Page2PartC :: FieldConst Centi
line52_credits = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line52", Text
"Amount"] Entry Centi
Amount,
   $sel:line53:Page2PartC :: FieldConst Centi
line53 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line53", Text
"Amount"] Entry Centi
Amount,
   $sel:line54:Page2PartC :: FieldConst Centi
line54 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line54", Text
"Amount"] Entry Centi
Amount,
   $sel:line55:Page2PartC :: FieldConst Centi
line55 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line55", Text
"Amount"] Entry Centi
Amount,
   $sel:line56:Page2PartC :: FieldConst Centi
line56 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Min-Tax-Carryover", Text
"Line56", Text
"Amount"] Entry Centi
Amount,
   $sel:line57:Page2PartC :: FieldConst Centi
line57 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Min-Tax-Carryover", Text
"Line57", Text
"Amount"] Entry Centi
Amount,
   $sel:line58:Page2PartC :: FieldConst Centi
line58 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Min-Tax-Carryover", Text
"Line58", Text
"Amount"] Entry Centi
Amount,
   $sel:line59_copy:Page2PartC :: FieldConst Centi
line59_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Min-Tax-Carryover", Text
"Line59", Text
"Amount1"] Entry Centi
Amount,
   $sel:line59_product:Page2PartC :: FieldConst Centi
line59_product = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Min-Tax-Carryover", Text
"Line59", Text
"Amount2"] Entry Centi
Amount,
   $sel:line60_lesser:Page2PartC :: FieldConst Centi
line60_lesser = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Min-Tax-Carryover", Text
"Line60", Text
"Amount"] Entry Centi
Amount,
   $sel:line61:Page2PartC :: FieldConst Centi
line61 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line61", Text
"Amount"] Entry Centi
Amount}

page3Fields :: Page3 FieldConst
page3Fields = Page3 {
   $sel:line62:Page3 :: FieldConst Centi
line62 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line62", Text
"Amount"] Entry Centi
Amount,
   $sel:line63:Page3 :: FieldConst Centi
line63 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ON-Surtax", Text
"Line63", Text
"Amount"] Entry Centi
Amount,
   $sel:line64:Page3 :: FieldConst Centi
line64 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ON-Surtax", Text
"Line64", Text
"Amount"] Entry Centi
Amount,
   $sel:line65:Page3 :: FieldConst Centi
line65 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"ON-Surtax", Text
"Line65", Text
"Amount"] Entry Centi
Amount,
   $sel:line66_copy:Page3 :: FieldConst Centi
line66_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line66", Text
"Amount1"] Entry Centi
Amount,
   $sel:line66_surtax:Page3 :: FieldConst Centi
line66_surtax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line66", Text
"Amount2"] Entry Centi
Amount,
   $sel:line67_copy:Page3 :: FieldConst Centi
line67_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line67", Text
"Amount1"] Entry Centi
Amount,
   $sel:line67_surtax:Page3 :: FieldConst Centi
line67_surtax = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line67", Text
"Amount2"] Entry Centi
Amount,
   $sel:line68_sum:Page3 :: SubCalculation FieldConst
line68_sum = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line68" [Text
"Amount1"] [Text
"Amount2"],
   $sel:line69:Page3 :: FieldConst Centi
line69 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line69", Text
"Amount2"] Entry Centi
Amount,
   $sel:line70:Page3 :: FieldConst Centi
line70 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line70", Text
"Amount"] Entry Centi
Amount,
   $sel:line71:Page3 :: FieldConst Centi
line71 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line71", Text
"Amount"] Entry Centi
Amount,
   $sel:line72:Page3 :: FieldConst Centi
line72 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line72", Text
"Amount"] Entry Centi
Amount,
   $sel:line73:Page3 :: FieldConst Centi
line73 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line73", Text
"Amount"] Entry Centi
Amount,
   $sel:line74_basicReduction:Page3 :: FieldConst Centi
line74_basicReduction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line74", Text
"Amount"] (Entry Centi -> FieldConst Centi)
-> Entry Centi -> FieldConst Centi
forall a b. (a -> b) -> a -> b
$ Centi -> Entry Centi -> Entry Centi
forall a. (Eq a, Show a) => a -> Entry a -> Entry a
Constant Centi
274 Entry Centi
Amount,
   $sel:line75_childrenNum:Page3 :: FieldConst Word
line75_childrenNum = [Text] -> Entry Word -> FieldConst Word
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line75", Text
"Line_60969", Text
"Number"] Entry Word
Count,
   $sel:line75_amount:Page3 :: FieldConst Centi
line75_amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line75", Text
"Amount"] Entry Centi
Amount,
   $sel:line76_childrenNum:Page3 :: FieldConst Word
line76_childrenNum = [Text] -> Entry Word -> FieldConst Word
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line76", Text
"Line_60970", Text
"Number"] Entry Word
Count,
   $sel:line76_amount:Page3 :: FieldConst Centi
line76_amount = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line76", Text
"Amount"] Entry Centi
Amount,
   $sel:line77:Page3 :: FieldConst Centi
line77 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line77", Text
"Amount"] Entry Centi
Amount,
   $sel:line78_copy:Page3 :: FieldConst Centi
line78_copy = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line78", Text
"Amount1"] Entry Centi
Amount,
   $sel:line78_product:Page3 :: FieldConst Centi
line78_product = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line78", Text
"Amount2"] Entry Centi
Amount,
   $sel:line79:Page3 :: FieldConst Centi
line79 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line79", Text
"Amount"] Entry Centi
Amount,
   $sel:line80_difference:Page3 :: SubCalculation FieldConst
line80_difference = Text -> [Text] -> [Text] -> SubCalculation FieldConst
subCalculationFields Text
"Line80" [Text
"Amount1"] [Text
"Amount2"],
   $sel:line81:Page3 :: FieldConst Centi
line81 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line81", Text
"Amount"] Entry Centi
Amount,
   $sel:line82:Page3 :: FieldConst Centi
line82 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line82", Text
"Amount"] Entry Centi
Amount,
   $sel:line83:Page3 :: FieldConst Centi
line83 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line83", Text
"Amount"] Entry Centi
Amount}

page4Fields :: Page4 FieldConst
page4Fields = Page4 {
   $sel:line84:Page4 :: FieldConst Centi
line84 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line84", Text
"Amount"] Entry Centi
Amount,
   $sel:line85_lift:Page4 :: FieldConst Centi
line85_lift = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line85", Text
"Amount"] Entry Centi
Amount,
   $sel:line86:Page4 :: FieldConst Centi
line86 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line86", Text
"Amount"] Entry Centi
Amount,
   $sel:line87_foodDonations:Page4 :: FieldConst Centi
line87_foodDonations = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line87", Text
"Line62150", Text
"Amount1"] Entry Centi
Amount,
   $sel:line87_fraction:Page4 :: FieldConst Centi
line87_fraction = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line87", Text
"Amount2"] Entry Centi
Amount,
   $sel:line88:Page4 :: FieldConst Centi
line88 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line88", Text
"Amount"] Entry Centi
Amount,
   $sel:line89_health:Page4 :: FieldConst Centi
line89_health = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line89", Text
"Amount"] Entry Centi
Amount,
   $sel:line90:Page4 :: FieldConst Centi
line90 = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Line90", Text
"Amount"] Entry Centi
Amount,
   $sel:healthPremium:Page4 :: HealthPremium FieldConst
healthPremium = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"ON_Health_Prenium-worksheet" (FieldConst a -> FieldConst a)
-> (FieldConst a -> FieldConst a) -> FieldConst a -> FieldConst a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Chart_ON_Health_Prenium" (forall {a}. FieldConst a -> FieldConst a)
-> HealthPremium FieldConst -> HealthPremium FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> HealthPremium p -> HealthPremium q
Rank2.<$> HealthPremium FieldConst
healthPremiumFields}

healthPremiumFields :: HealthPremium FieldConst
healthPremiumFields = HealthPremium {
   $sel:row1:HealthPremium :: HealthPremiumBracket FieldConst
row1 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Taxable_Line2" (forall {a}. FieldConst a -> FieldConst a)
-> HealthPremiumBracket FieldConst
-> HealthPremiumBracket FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a)
-> HealthPremiumBracket p -> HealthPremiumBracket q
Rank2.<$> HealthPremiumBracket FieldConst
healthPremiumBracketFields{HealthPremiumBracket.equalsTax = NoField},
   $sel:row2:HealthPremium :: HealthPremiumBracket FieldConst
row2 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Taxable_Line4" (forall {a}. FieldConst a -> FieldConst a)
-> HealthPremiumBracket FieldConst
-> HealthPremiumBracket FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a)
-> HealthPremiumBracket p -> HealthPremiumBracket q
Rank2.<$> HealthPremiumBracket FieldConst
healthPremiumBracketFields,
   $sel:row3:HealthPremium :: HealthPremiumBracket FieldConst
row3 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Taxable_Line6" (forall {a}. FieldConst a -> FieldConst a)
-> HealthPremiumBracket FieldConst
-> HealthPremiumBracket FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a)
-> HealthPremiumBracket p -> HealthPremiumBracket q
Rank2.<$> HealthPremiumBracket FieldConst
healthPremiumBracketFields,
   $sel:row4:HealthPremium :: HealthPremiumBracket FieldConst
row4 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Taxable_Line8" (forall {a}. FieldConst a -> FieldConst a)
-> HealthPremiumBracket FieldConst
-> HealthPremiumBracket FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a)
-> HealthPremiumBracket p -> HealthPremiumBracket q
Rank2.<$> HealthPremiumBracket FieldConst
healthPremiumBracketFields,
   $sel:row5:HealthPremium :: HealthPremiumBracket FieldConst
row5 = Text -> FieldConst a -> FieldConst a
forall x. Text -> FieldConst x -> FieldConst x
within Text
"Taxable_Line10" (forall {a}. FieldConst a -> FieldConst a)
-> HealthPremiumBracket FieldConst
-> HealthPremiumBracket FieldConst
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a)
-> HealthPremiumBracket p -> HealthPremiumBracket q
Rank2.<$> HealthPremiumBracket FieldConst
healthPremiumBracketFields}

healthPremiumBracketFields :: HealthPremiumBracket FieldConst
healthPremiumBracketFields = HealthPremiumBracket {
   $sel:taxableIncome:HealthPremiumBracket :: FieldConst Centi
taxableIncome = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Amount1"] Entry Centi
Amount,
   $sel:overThreshold:HealthPremiumBracket :: FieldConst Centi
overThreshold = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Amount2"] Entry Centi
Amount,
   $sel:timesRate:HealthPremiumBracket :: FieldConst Centi
timesRate     = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Amount3"] Entry Centi
Amount,
   $sel:equalsTax:HealthPremiumBracket :: FieldConst Centi
equalsTax     = [Text] -> Entry Centi -> FieldConst Centi
forall a. [Text] -> Entry a -> FieldConst a
Field [Text
"Amount4"] Entry Centi
Amount}