| [613] | 1 | EASECPC1 ;ALB/LBD,CKN - LTC CoPayment Report continuation ; 6-FEB-2002
|
|---|
| 2 | ;;1.0;ENROLLMENT APPLICATION SYSTEM;**7,24,40**;Mar 15, 2001
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine is a continuation of EASECPC.
|
|---|
| 5 | ;
|
|---|
| 6 | ; Input: DFN - Patient file IEN
|
|---|
| 7 | ; DGMTI - LTC Copay Test IEN (file #408.31)
|
|---|
| 8 | ; DGMTDT - LTC Copay Test Date
|
|---|
| 9 | ; MAXRT - Maximum daily copay rates for LTC (OP^IP)
|
|---|
| 10 | ; EASRPT - Report type: 1=Institutional (IP)
|
|---|
| 11 | ; 2=Non-Institutional (OP)
|
|---|
| 12 | ; EASRDT - Report start date
|
|---|
| 13 | ; EASADM - LTC admission date (only if EASRPT=1)
|
|---|
| 14 | ;
|
|---|
| 15 | START ; Generate Report
|
|---|
| 16 | N ARRY,IPRPT,DGSP,SRIC,LSEP,DECINF,AGRPAY,ERR
|
|---|
| 17 | I $G(ZTSK) S ZTREQ="@"
|
|---|
| 18 | D INIT(EASRDT,.ARRY)
|
|---|
| 19 | D BLDTBL(.ARRY) Q:$G(ERR)
|
|---|
| 20 | D PRINT
|
|---|
| 21 | Q
|
|---|
| 22 | PRINT ; Print the Report
|
|---|
| 23 | N CRT,PAGE,RPTDT,LINE,HDR,CALC1,CALC2,SIDX,EIDX,MNTH,NAME,SSN,DOB,LOS
|
|---|
| 24 | D PRTVAR
|
|---|
| 25 | U IO
|
|---|
| 26 | D HEADER
|
|---|
| 27 | W !,$S(DGSP:"MARRIED",LSEP:"LEGALLY SEPARATED",1:"SINGLE")
|
|---|
| 28 | W:SRIC ?15,"SPOUSE RESIDING IN THE COMMUNITY"
|
|---|
| 29 | I DECINF,AGRPAY W !,"*** DECLINED TO PROVIDE INCOME INFORMATION -- AGREED TO PAY COPAYMENTS ***"
|
|---|
| 30 | I AGRPAY=0 W !,"*** VETERAN IS INELIGIBLE FOR LTC SERVICES -- REFUSED TO SIGN 10-10EC ***"
|
|---|
| 31 | W !,"LTC COPAY TEST DATE: ",$$FMTE^XLFDT(DGMTDT)
|
|---|
| 32 | W:$G(EASADM) ?47,"LTC ADMISSION DATE: ",$$FMTE^XLFDT(EASADM)
|
|---|
| 33 | W !!!,"LTC COPAYMENT CALCULATION"_$S(IPRPT:"S:",1:":")
|
|---|
| 34 | W ! W:IPRPT "FOR DAYS 1-180 " W CALC1
|
|---|
| 35 | I IPRPT W !,"FOR DAYS 181+ " W CALC2
|
|---|
| 36 | ;
|
|---|
| 37 | S SIDX=1,EIDX=6
|
|---|
| 38 | W !!," "
|
|---|
| 39 | F MNTH=1:1:6 W $J($P(ARRY(MNTH),"^"),11)
|
|---|
| 40 | I IPRPT D PRINTROW("TOT ASSETS ",SIDX,EIDX,9)
|
|---|
| 41 | D PRINTROW("TOT INCOME ",SIDX,EIDX,3)
|
|---|
| 42 | I 'IPRPT!($G(LOS)<181)!(DGSP&(SRIC)) D PRINTROW("TOT EXPENSES ",SIDX,EIDX,4)
|
|---|
| 43 | D PRINTROW("TOT ALLOWANCE ",SIDX,EIDX,5)
|
|---|
| 44 | W ! D PRINTROW("CALC COPAY ",SIDX,EIDX,6)
|
|---|
| 45 | D PRINTROW("MAX COPAY ",SIDX,EIDX,7)
|
|---|
| 46 | W !,LINE
|
|---|
| 47 | D PRINTROW("VET COPAY ",SIDX,EIDX,8)
|
|---|
| 48 | W !,LINE
|
|---|
| 49 | ;
|
|---|
| 50 | S SIDX=7,EIDX=12
|
|---|
| 51 | W !!," "
|
|---|
| 52 | F MNTH=7:1:12 W $J($P(ARRY(MNTH),"^"),11)
|
|---|
| 53 | I IPRPT D PRINTROW("TOT ASSETS ",SIDX,EIDX,9)
|
|---|
| 54 | D PRINTROW("TOT INCOME ",SIDX,EIDX,3)
|
|---|
| 55 | I 'IPRPT!(DGSP&(SRIC)) D PRINTROW("TOT EXPENSES ",SIDX,EIDX,4)
|
|---|
| 56 | D PRINTROW("TOT ALLOWANCE ",SIDX,EIDX,5)
|
|---|
| 57 | W ! D PRINTROW("CALC COPAY ",SIDX,EIDX,6)
|
|---|
| 58 | D PRINTROW("MAX COPAY ",SIDX,EIDX,7)
|
|---|
| 59 | W !,LINE
|
|---|
| 60 | D PRINTROW("VET COPAY ",SIDX,EIDX,8)
|
|---|
| 61 | W !,LINE
|
|---|
| 62 | ;
|
|---|
| 63 | I CRT Q:$$PAUSE(0)
|
|---|
| 64 | D:CRT HEADER
|
|---|
| 65 | D NOTETXT
|
|---|
| 66 | I CRT Q:$$PAUSE(0)
|
|---|
| 67 | I IPRPT D HEADER,SPNDDWN I CRT Q:$$PAUSE(0)
|
|---|
| 68 | Q
|
|---|
| 69 | PRINTROW(TEXT,SIDX,EIDX,NODE) ; Print the Rows
|
|---|
| 70 | N MNTH
|
|---|
| 71 | W !,TEXT
|
|---|
| 72 | F MNTH=SIDX:1:EIDX W $J($S($P(ARRY(MNTH),"^",NODE)[".":$P($P(ARRY(MNTH),"^",NODE),"."),1:$P(ARRY(MNTH),"^",NODE)),11)
|
|---|
| 73 | Q
|
|---|
| 74 | PRTVAR ; Set up variables needed to print report
|
|---|
| 75 | N PAT0
|
|---|
| 76 | S CRT=$S($E(IOST,1,2)="C-":1,1:0)
|
|---|
| 77 | S PAGE=0,RPTDT=$$FMTE^XLFDT(DT)
|
|---|
| 78 | S LINE="",$P(LINE,"-",81)=""
|
|---|
| 79 | S HDR=$$CJ^XLFSTR("LONG TERM CARE ESTIMATED COPAYMENTS FOR "_$S('IPRPT:"NON-",1:"")_"INSTITUTIONAL SERVICES",80)
|
|---|
| 80 | S PAT0=$G(^DPT(DFN,0)),NAME=$P(PAT0,"^"),DOB=$P(PAT0,"^",3)
|
|---|
| 81 | S SSN=$P(PAT0,"^",9),SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
|
|---|
| 82 | S CALC1="TOTAL INCOME - TOTAL EXPENSES - TOTAL ALLOWANCE"
|
|---|
| 83 | I DGSP,SRIC S CALC2="(TOTAL ASSETS + TOTAL INCOME) - TOTAL EXPENSES - TOTAL ALLOWANCE"
|
|---|
| 84 | E S CALC2="(TOTAL ASSETS + TOTAL INCOME) - TOTAL ALLOWANCE"
|
|---|
| 85 | S:$G(EASADM) LOS=$$FMDIFF^XLFDT(EASRDT,EASADM)
|
|---|
| 86 | Q
|
|---|
| 87 | HEADER ; Print the header
|
|---|
| 88 | S PAGE=PAGE+1
|
|---|
| 89 | W @IOF
|
|---|
| 90 | W RPTDT,?71,"Page: ",$J(PAGE,3)
|
|---|
| 91 | W !!,HDR
|
|---|
| 92 | W !!,NAME,?35,SSN,?62,"DOB: ",$$FMTE^XLFDT(DOB)
|
|---|
| 93 | Q
|
|---|
| 94 | PAUSE(RESP) ; Prompt user for next page or quit
|
|---|
| 95 | N DIR,DIRUT,DUOUT,DTOUT,U,X,Y
|
|---|
| 96 | S DIR(0)="E"
|
|---|
| 97 | D ^DIR
|
|---|
| 98 | I 'Y S RESP=1
|
|---|
| 99 | Q RESP
|
|---|
| 100 | ;
|
|---|
| 101 | INIT(DATE,ARRY) ; Initialize the Month/Year Table
|
|---|
| 102 | N IDX,MNYR
|
|---|
| 103 | S MNYR=$E(DATE,1,5)_"00"
|
|---|
| 104 | F IDX=1:1:12 D
|
|---|
| 105 | .S ARRY(IDX)=$$UP^XLFSTR($$FMTE^XLFDT(MNYR))
|
|---|
| 106 | .S ARRY(IDX)=$P(ARRY(IDX)," ")_"'"_$E($P(ARRY(IDX)," ",2),3,4)
|
|---|
| 107 | .S $P(ARRY(IDX),"^",2)=MNYR
|
|---|
| 108 | .S MNYR=MNYR+100
|
|---|
| 109 | .S:$E(MNYR,4,5)=13 MNYR=$E(MNYR,1,3)+1_"0100"
|
|---|
| 110 | Q
|
|---|
| 111 | BLDTBL(ARRY) ; Get the veteran's financial data, do the copay calculations,
|
|---|
| 112 | ; build the data table
|
|---|
| 113 | ;
|
|---|
| 114 | N DGDC,DGDEP,DGERR,DGFL,DGIN0,DGIN1,DGIN2,DGINI,DGIRI,DGDET,DGINT,DGNWT
|
|---|
| 115 | N DGPRI,DGNC,DGND,DGNWTF,DGVINI,DGVIR0,DGVIRI,DGVPRI,DGINTF,CPYFLG,IDX
|
|---|
| 116 | N OVR180,TAST,TINC,TEXP,ALLOW,CALCCPY,DAYS,MAXCPY,VETMAX,IPDR,OPDR,LOS
|
|---|
| 117 | ;
|
|---|
| 118 | S ERR=0
|
|---|
| 119 | S DGPRI=$O(^DGPR(408.12,"C",DFN_";DPT(",0)) I 'DGPRI S ERR=1 Q
|
|---|
| 120 | D GETIENS^EASECU2(DFN,DGPRI,DGMTDT) I '$G(DGIRI),'$G(DGINI) S ERR=1 Q
|
|---|
| 121 | S DGVIRI=DGIRI,DGVINI=DGINI
|
|---|
| 122 | D DEP^EASECSU3,INC^EASECSU3
|
|---|
| 123 | S IPRPT=$S(EASRPT=1:1,1:0)
|
|---|
| 124 | S CPYFLG=0
|
|---|
| 125 | S DECINF=$P($G(^DGMT(408.31,DGMTI,0)),"^",14)
|
|---|
| 126 | S AGRPAY=$P($G(^DGMT(408.31,DGMTI,0)),"^",11)
|
|---|
| 127 | I DECINF=1!(AGRPAY=0) S CPYFLG=1
|
|---|
| 128 | S SRIC=$P(DGVIR0,U,16),LSEP=$P(DGVIR0,U,17)
|
|---|
| 129 | S OPDR=$P(MAXRT,U),IPDR=$P(MAXRT,U,2)
|
|---|
| 130 | I IPRPT S LOS=$$FMDIFF^XLFDT(EASRDT,EASADM)+1
|
|---|
| 131 | ;
|
|---|
| 132 | S OVR180=$S($G(LOS)>180:1,1:0)
|
|---|
| 133 | S TINC=DGINT/12,TEXP=DGDET/12
|
|---|
| 134 | I OVR180,('DGSP!('SRIC)) S TEXP=0
|
|---|
| 135 | S TAST=DGNWT I OVR180 S TAST=$$ASSET
|
|---|
| 136 | ;
|
|---|
| 137 | ; Build data table
|
|---|
| 138 | F IDX=1:1:12 D
|
|---|
| 139 | .S DAYS=$$DOM($P(ARRY(IDX),"^",2))
|
|---|
| 140 | .D CALCALL
|
|---|
| 141 | .S $P(ARRY(IDX),"^",3)=TINC
|
|---|
| 142 | .S $P(ARRY(IDX),"^",4)=TEXP
|
|---|
| 143 | .S $P(ARRY(IDX),"^",5)=ALLOW
|
|---|
| 144 | .S $P(ARRY(IDX),"^",6)=CALCCPY
|
|---|
| 145 | .S $P(ARRY(IDX),"^",7)=MAXCPY
|
|---|
| 146 | .S $P(ARRY(IDX),"^",8)=VETMAX
|
|---|
| 147 | .S $P(ARRY(IDX),"^",9)=$S(OVR180:TAST,1:"-")
|
|---|
| 148 | .S:OVR180 TAST=$$ASTSPD
|
|---|
| 149 | .I $G(LOS) D
|
|---|
| 150 | ..S LOS=LOS+DAYS
|
|---|
| 151 | ..S:'OVR180 OVR180=$S(LOS>180:1,1:0)
|
|---|
| 152 | ..I OVR180,('DGSP!'(SRIC)) S:TEXP TEXP=0
|
|---|
| 153 | Q
|
|---|
| 154 | ;
|
|---|
| 155 | CALCALL ; Calculate the allowance and all the copayment amounts
|
|---|
| 156 | S ALLOW=20*DAYS*(1+SRIC) S:CPYFLG ALLOW=0
|
|---|
| 157 | S CALCCPY=$$CALCCPY
|
|---|
| 158 | S MAXCPY=$$CALCMAX(DAYS)
|
|---|
| 159 | S VETMAX=$$VETMAX(CALCCPY,MAXCPY)
|
|---|
| 160 | Q
|
|---|
| 161 | ASSET() ; Initialize asset amount by applying spend-down
|
|---|
| 162 | N NUM,MNYR,J,DONE,DAYS,ALLOW,CALCCPY,MAXCPY,VETMAX
|
|---|
| 163 | S DONE=0
|
|---|
| 164 | ; Calculate number of months to spend down the assets
|
|---|
| 165 | S NUM=(LOS-180)\30
|
|---|
| 166 | ; Get month to start spend down
|
|---|
| 167 | S MNYR=$$FMADD^XLFDT(EASADM,180)
|
|---|
| 168 | I NUM>0 F J=1:1:NUM D Q:DONE
|
|---|
| 169 | .S DAYS=$$DOM(MNYR)
|
|---|
| 170 | .D CALCALL
|
|---|
| 171 | .S TAST=$$ASTSPD I TAST=0 S DONE=1 Q
|
|---|
| 172 | .S MNYR=MNYR+100 S:$E(MNYR,4,5)=13 MNYR=$E(MNYR,1,3)+1_"0100"
|
|---|
| 173 | Q TAST
|
|---|
| 174 | ASTSPD() ;Asset Spend down for 180+ days
|
|---|
| 175 | Q:CPYFLG TAST
|
|---|
| 176 | I (TINC-TEXP-ALLOW)'>VETMAX D
|
|---|
| 177 | . I DGSP,SRIC S TAST=TAST-(VETMAX-(TINC-TEXP-ALLOW))
|
|---|
| 178 | . E S TAST=TAST-(VETMAX-(TINC-ALLOW))
|
|---|
| 179 | . S:TAST<0 TAST=0
|
|---|
| 180 | Q TAST
|
|---|
| 181 | ;
|
|---|
| 182 | CALCCPY() ; Calculate the Co-Pay Amount
|
|---|
| 183 | ;
|
|---|
| 184 | Q:CPYFLG 0
|
|---|
| 185 | Q:OVR180 TAST+TINC-ALLOW-TEXP
|
|---|
| 186 | Q TINC-ALLOW-TEXP
|
|---|
| 187 | DOM(MNYR) ; Days in Month
|
|---|
| 188 | ; Returns: number of days in a month
|
|---|
| 189 | N DAYS,MN,YR
|
|---|
| 190 | S MN=+$E(MNYR,4,5)
|
|---|
| 191 | I "^4^6^9^11^"[("^"_MN_"^") S DAYS=30 Q DAYS
|
|---|
| 192 | I MN=2 D Q DAYS
|
|---|
| 193 | .S DAYS=28
|
|---|
| 194 | .S YR=$E(MNYR,1,3)+1700
|
|---|
| 195 | .S:YR#4=0 DAYS=29
|
|---|
| 196 | S DAYS=31
|
|---|
| 197 | Q DAYS
|
|---|
| 198 | CALCMAX(DAYS) ; Calculate the Maximum Co-Pay Amount
|
|---|
| 199 | ;
|
|---|
| 200 | Q $S(IPRPT:IPDR,1:OPDR)*DAYS
|
|---|
| 201 | VETMAX(CALCCPY,MAXCPY) ; Calculate the Veteran Maximum Co-Pay Amount
|
|---|
| 202 | ;
|
|---|
| 203 | Q:CPYFLG MAXCPY
|
|---|
| 204 | Q:CALCCPY<0 0
|
|---|
| 205 | Q:CALCCPY<MAXCPY CALCCPY
|
|---|
| 206 | Q MAXCPY
|
|---|
| 207 | ;
|
|---|
| 208 | NOTETXT ; Write the Note message
|
|---|
| 209 | W !!,"IMPORTANT NOTICE: The copayment amounts shown in this report are"
|
|---|
| 210 | W " estimates",!,"based on calculations of the copayment amount for "
|
|---|
| 211 | W "an entire month. The",!,"copayment amounts will be adjusted to "
|
|---|
| 212 | W "reflect the actual start date of LTC",!,"services and the "
|
|---|
| 213 | W "copayment exemption for the first 21 days of service. The VET",!
|
|---|
| 214 | W "COPAY amount is based on the assumption that the veteran "
|
|---|
| 215 | W "will be responsible",!,"to pay the lesser of EITHER the calculated"
|
|---|
| 216 | W " copayment (CALC COPAY) OR the",!,"maximum copayment (MAX COPAY). "
|
|---|
| 217 | W "In the event that the calculated copayment",!,"(CALC COPAY) is a "
|
|---|
| 218 | W "negative figure, the veteran copayment (VET COPAY)",!
|
|---|
| 219 | W "will be adjusted to zero (0). If the veteran declined to provide"
|
|---|
| 220 | W " income",!,"information, the veteran will be obligated to pay the"
|
|---|
| 221 | W " maximum copayment."
|
|---|
| 222 | Q
|
|---|
| 223 | ;
|
|---|
| 224 | SPNDDWN ; Text of message to explain the asset spend down
|
|---|
| 225 | W !!,"EXPLANATION OF ASSET SPEND DOWN CALCULATION:"
|
|---|
| 226 | W !,"============================================"
|
|---|
| 227 | W !,"The veteran's assets are included in the calculation of copayments"
|
|---|
| 228 | W !,"after 180 days of institutional LTC services. The assets then may"
|
|---|
| 229 | W !,"be reduced each month according to the following formula:"
|
|---|
| 230 | W !
|
|---|
| 231 | W !,"Single Veteran:"
|
|---|
| 232 | W !
|
|---|
| 233 | W !," TOTAL ASSETS-(VET COPAY-(INCOME-ALLOWANCE))"
|
|---|
| 234 | W !
|
|---|
| 235 | W !,"Married Veteran (spouse residing in the community):"
|
|---|
| 236 | W !
|
|---|
| 237 | W !," TOTAL ASSETS-(VET COPAY-(INCOME-EXPENSES-ALLOWANCE))"
|
|---|
| 238 | W !
|
|---|
| 239 | W !,"In other words, the assets will be reduced by the amount of the"
|
|---|
| 240 | W !,"veteran's copayment that is not covered by the veteran's income "
|
|---|
| 241 | W !,"after all expenses and allowances are subtracted. If the amount"
|
|---|
| 242 | W !,"of the veteran's income after all expenses and allowances are"
|
|---|
| 243 | W !,"subtracted is greater than the veteran's copayment then the assets"
|
|---|
| 244 | W !,"will not be reduced."
|
|---|
| 245 | W !
|
|---|
| 246 | Q
|
|---|
