| 1 | EASECCAL ;ALB/LBD - Calculate LTC copayment ;27 AUG 2001
|
|---|
| 2 | ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,19,34,39,40**;Mar 15, 2001
|
|---|
| 3 | ;
|
|---|
| 4 | ; Input -- DFN Patient IEN
|
|---|
| 5 | ; MNTH Last day of month for the LTC copay calculation
|
|---|
| 6 | ; in FM format (e.g. 3020131)
|
|---|
| 7 | ; LOS (Length of stay) The number of days in the patient's
|
|---|
| 8 | ; LTC episode
|
|---|
| 9 | ; Output -- COPAY String containing copayment calculation
|
|---|
| 10 | ; = 0: no completed LTC copay test on file
|
|---|
| 11 | ; piece 1: LTC copay test status
|
|---|
| 12 | ; (1=Exempt; 2=Non-Exempt)
|
|---|
| 13 | ; 2: If Exempt, Reason for Exemption
|
|---|
| 14 | ; (IEN to file #714.1)
|
|---|
| 15 | ; 3: Calculated LTC copayment for IP
|
|---|
| 16 | ; (1-180 days)
|
|---|
| 17 | ; 4: Calculated LTC copayment for IP
|
|---|
| 18 | ; (181+ days)
|
|---|
| 19 | ; 5: Calculated LTC copayment for OP
|
|---|
| 20 | ;
|
|---|
| 21 | COPAY(DFN,MNTH,LOS) ;
|
|---|
| 22 | N COPAY,DAYS,MX,IPDR,OPDR,IPMAX,OPMAX,LST,DGMT,DGMTI,DGMTDT,DGSTA,DGEXR
|
|---|
| 23 | N ERR,X1,X2,INC,EXP,AST,ALLOW,DGSP,SRIC
|
|---|
| 24 | S COPAY=0
|
|---|
| 25 | I 'DFN!('MNTH) G Q
|
|---|
| 26 | S LOS=+$G(LOS),DAYS=$E(MNTH,6,7)
|
|---|
| 27 | ; Get maximum daily rate for LTC copayments
|
|---|
| 28 | ; DBIA #3717
|
|---|
| 29 | S MX=$$MAXRATE^IBAECU(MNTH),OPDR=$P(MX,U),IPDR=$P(MX,U,2) I 'OPDR!('IPDR) G Q
|
|---|
| 30 | ; Calculate maximum copayment for the month
|
|---|
| 31 | S OPMAX=DAYS*OPDR,IPMAX=DAYS*IPDR
|
|---|
| 32 | ; Get last completed LTC copay test
|
|---|
| 33 | S LST=$$LST^EASECU(DFN,MNTH,3) I +LST=0 G Q
|
|---|
| 34 | S DGMTI=$P(LST,U),DGMT(0)=$G(^DGMT(408.31,DGMTI,0)) I 'DGMT(0) G Q
|
|---|
| 35 | S DGMTDT=+DGMT(0),DGSTA=$P($G(^DG(408.32,+$P(DGMT(0),U,3),0)),U,1)
|
|---|
| 36 | S DGEXR=$P($G(^DGMT(408.31,DGMTI,2)),U,7)
|
|---|
| 37 | ; If LTC copay test status is neither NON-EXEMPT nor EXEMPT, quit
|
|---|
| 38 | I DGSTA'="NON-EXEMPT",DGSTA'="EXEMPT" G Q
|
|---|
| 39 | ; If LTC copay test is more than a year old and the veteran does
|
|---|
| 40 | ; not have an exemption for eligibility (Compensable SC) or LTC
|
|---|
| 41 | ; before 11/30/99, quit (Added for LTC Phase III - EAS*1*34)
|
|---|
| 42 | ;S X1=MNTH,X2=DGMTDT D ^%DTC I X>365,"^1^4^"'[(U_DGEXR_U) G Q
|
|---|
| 43 | S COPAY=$S(DGSTA="EXEMPT":1,1:2)_U
|
|---|
| 44 | ; If test status = 'EXEMPT', get Reason for Exemption
|
|---|
| 45 | I DGSTA="EXEMPT" S COPAY=COPAY_DGEXR
|
|---|
| 46 | ; If veteran declined to give financial info, copay = max monthly copay
|
|---|
| 47 | I $P(DGMT(0),U,14) S COPAY=COPAY_U_IPMAX_U_IPMAX_U_OPMAX G Q
|
|---|
| 48 | ; Get total income, assets and expenses for veteran (and spouse)
|
|---|
| 49 | D FINTOT I $G(ERR) D G Q
|
|---|
| 50 | .I +COPAY=1 Q
|
|---|
| 51 | .;no financial data but veteran agreed to pay copayments, copay = max
|
|---|
| 52 | .I $P(DGMT(0),U,11) S COPAY=COPAY_U_IPMAX_U_IPMAX_U_OPMAX Q
|
|---|
| 53 | .S COPAY=0
|
|---|
| 54 | ; Calculate copayments
|
|---|
| 55 | D CALC
|
|---|
| 56 | Q ; Quit and return COPAY
|
|---|
| 57 | Q COPAY
|
|---|
| 58 | ;
|
|---|
| 59 | FINTOT ; Get total income, assets and expenses for veteran (and spouse)
|
|---|
| 60 | N DGDC,DGDEP,DGDET,DGERR,DGIN0,DGIN1,DGIN2,DGINI,DGINT,DGINTF,DGIRI
|
|---|
| 61 | N DGNC,DGND,DGNWT,DGNWTF,DGPRI,DGVINI,DGVIR0,DGVIRI
|
|---|
| 62 | S ERR=0
|
|---|
| 63 | S DGPRI=$O(^DGPR(408.12,"C",DFN_";DPT(",0)) I 'DGPRI S ERR=1 Q
|
|---|
| 64 | D GETIENS^EASECU2(DFN,DGPRI,DGMTDT) I '$G(DGIRI),'$G(DGINI) S ERR=1 Q
|
|---|
| 65 | S DGVIRI=DGIRI,DGVINI=DGINI
|
|---|
| 66 | D DEP^EASECSU3
|
|---|
| 67 | D INC^EASECSU3
|
|---|
| 68 | I DGINT=0,DGDET=0,DGNWT=0 S ERR=1 Q
|
|---|
| 69 | ; Does spouse reside in community?
|
|---|
| 70 | S SRIC=$P(DGVIR0,U,16)
|
|---|
| 71 | ; Divide income and expense totals by 12 to get monthly amounts
|
|---|
| 72 | S INC=DGINT/12,EXP=DGDET/12,AST=DGNWT
|
|---|
| 73 | ; Calculate total monthly allowance:
|
|---|
| 74 | ; 20*number of days in month*(veteran+spouse(if married and spouse
|
|---|
| 75 | ; resides in the community))
|
|---|
| 76 | S ALLOW=20*DAYS*(1+SRIC)
|
|---|
| 77 | Q
|
|---|
| 78 | ;
|
|---|
| 79 | CALC ; Calculate copayments
|
|---|
| 80 | N CCPY,OPCPY,IPCPY1,IPCPY2,TINC,TEXP,TAST,OVR180,IPRPT,CPYFLG,EASADM
|
|---|
| 81 | ; Calculation for IP services up to 180 days and OP services:
|
|---|
| 82 | ; Income-Allowance-Expenses
|
|---|
| 83 | S CCPY=INC-ALLOW-EXP
|
|---|
| 84 | S (OPCPY,IPCPY1)=$S(CCPY>0:(CCPY+.5)\1,1:0)
|
|---|
| 85 | ; Calculation for IP services 181+ days, add in assets
|
|---|
| 86 | S IPCPY2=0 I LOS>180 D
|
|---|
| 87 | . S TEXP=0 I DGSP,SRIC S TEXP=TEXP+EXP
|
|---|
| 88 | . S TINC=INC,TAST=AST,(OVR180,IPRPT)=1,CPYFLG=0
|
|---|
| 89 | . S EASADM=$$FMADD^XLFDT(MNTH,-LOS)
|
|---|
| 90 | . ; Get value of assets after spenddown is applied
|
|---|
| 91 | . S TAST=$$ASSET^EASECPC1
|
|---|
| 92 | . S CCPY=CCPY+TAST
|
|---|
| 93 | . ;If veteran is single or spouse does not reside in the community,
|
|---|
| 94 | . ;add expenses back in
|
|---|
| 95 | . I 'DGSP!('SRIC) S CCPY=CCPY+EXP
|
|---|
| 96 | . S IPCPY2=(CCPY+.5)\1 I IPCPY2<0 S IPCPY2=0
|
|---|
| 97 | S COPAY=COPAY_U_IPCPY1_U_IPCPY2_U_OPCPY
|
|---|
| 98 | Q
|
|---|
