DGMTSCU4 ;ALB/CMF - Means Test Maximum Annual Pension Rate Utilities ;4 OCT 2004 3:33 pm
;;5.3;Registration;**624**;Aug 13, 1993
;
Q
MEDEXP(DGGRS,DGADJ,DGYR,DGDEP) ;
; in: DGGRS = gross medical expense, default is 0
; DGADJ = adjusted medical expense, default is 0
; DGYR = rate table year
; DGDEP = # of dependents
; out: if gross >0, adjusted medical expense
; if adjusted > 0, gross medical expense (back-compute)
; else 0
N DGRTN,DGMAP,DGPER,DGADD
; initialize variables, quit if inappropriate
S DGRTN=0
S DGGRS=$S(+$G(DGGRS)>0:DGGRS,1:0)
S DGADJ=$S(+DGGRS:0,+$G(DGADJ)>0:DGADJ,1:0)
Q:(DGGRS=0)&(DGADJ=0) DGRTN
S DGYR=$S(+$G(DGYR):DGYR,1:-1)
Q:DGYR=-1 DGRTN
S DGDEP=$S(+$G(DGDEP):+DGDEP,1:0)
;
; get global % rate
S DGPER=$$GET^XPAR("PKG","DGMT MAPR GLOBAL RATE",DGYR)
Q:DGPER="" DGRTN
;
; get max annual value
I DGDEP=0 S DGMAP=$$GET^XPAR("PKG","DGMT MAPR 0 DEPENDENTS",DGYR)
I DGDEP>0 S DGMAP=$$GET^XPAR("PKG","DGMT MAPR 1 DEPENDENTS",DGYR)
S DGADD=0
D:DGDEP>1
.S DGADD=$$GET^XPAR("PKG","DGMT MAPR N DEPENDENTS",DGYR)
.S DGADD=DGADD*(DGDEP-1)
.Q
;
S DGRTN=(DGMAP+DGADD)*DGPER/100
D:DGGRS>0
.S DGRTN=DGGRS-DGRTN
.S DGRTN=$S(DGRTN>0:DGRTN,1:0)
.Q
;
D:DGADJ>0
.S DGRTN=DGADJ+DGRTN
.S DGRTN=$S(DGRTN>0:DGRTN,1:0)
.Q
;
Q DGRTN
;
ND(DGP1,DGP2,DGP3) ;return # of deps for a test
; in: dgp1:DFN = patient ien
; dgp2:DGMTDT = means test date
; dgp3:DGVIRI = veteran income relation ien
; out: DGND = # of dependents for a test
N DGDC,DGNC,DGND,DGSP,DGVIR0,DFN,DGMTDT,DGVIRI
S DFN=+$G(DGP1)
S DGMTDT=+$G(DGP2)
S DGVIRI=+$G(DGP3)
Q:(DFN=0)!(DGMTDT=0)!(DGVIRI=0) 0
D DEP^DGMTSCU2
Q $S(DGND<0:0,DGND<21:DGND,1:20)
;
GRSADJ(DGP1,DGP2,DGP3,DGP4) ;write adjusted medical expense
;called from [DGMT ENTER/EDIT EXPENSES] edit template
; in: see $$ADJUST
; out: text string with adjusted medical expense
N DGADJ
S DGADJ=$$ADJUST(DGP1,DGP2,DGP3,DGP4)
S DGADJ=$$AMT^DGMTSCU1(DGADJ)
Q "ADJUSTED MEDICAL EXPENSES: "_DGADJ_"//"
;
ADJUST(DGP1,DGP2,DGP3,DGP4) ;derive adjust med exp from gross med exp
; in: dgp1:DGVINI = veteran income test ien
; dgp2:DGDFN = patient ien
; dgp3:DGMTDT = means test date
; dgp4:DGVIRI = veteran income relation ien
; out: adjusted medical expense or -1 if not set
N DGND,DGYR,DGGRS,DGADJ,DGVINI,DGDFN,DGMTDT,DGVIRI
S DGVINI=+$G(DGP1)
S DGDFN=+$G(DGP2)
S DGMTDT=+$G(DGP3)
S DGVIRI=+$G(DGP4)
Q:(DGVINI=0)!(DGDFN=0)!(DGMTDT=0)!(DGVIRI=0) -1
Q:'$D(^DGMT(408.21,DGVINI,1)) 0
S DGND=$$ND(DGDFN,DGMTDT,DGVIRI)
S DGYR=$$YEAR(DGMTDT)
S DGGRS=$P(^DGMT(408.21,DGVINI,1),U,12)
S DGADJ=$$MEDEXP(DGGRS,,DGYR,DGND)
S $P(^DGMT(408.21,DGVINI,1),U)=DGADJ
Q DGADJ
;
GROSS(DGP1,DGP2,DGP3,DGP4) ;derive gross med exp from adj med exp
; in: dgp1:DGVINI = veteran income test ien
; dgp2:DGDFN = patient ien
; dgp3:DGMTDT = means test date
; dgp4:DGVIRI = veteran income relation ien
; out: gross medical expense reset if necessary
N DGND,DGYR,DGGRS,DGADJ,DGVINI,DGDFN,DGMTDT,DGVIRI
S DGVINI=+$G(DGP1)
S DGDFN=+$G(DGP2)
S DGMTDT=+$G(DGP3)
S DGVIRI=+$G(DGP4)
Q:(DGVINI=0)!(DGDFN=0)!(DGMTDT=0)!(DGVIRI=0)
Q:'$D(^DGMT(408.21,DGVINI,1))
S DGGRS=+$P(^DGMT(408.21,DGVINI,1),U,12)
S DGADJ=+$P(^DGMT(408.21,DGVINI,1),U,1)
Q:DGGRS+DGADJ=0
Q:DGADJ=0
S DGND=$$ND(DGDFN,DGMTDT,DGVIRI)
S DGYR=$$YEAR(DGMTDT)
Q:DGADJ=$$MEDEXP(DGGRS,,DGYR,DGND)
S DGGRS=$$MEDEXP(,DGADJ,DGYR,DGND)
S $P(^DGMT(408.21,DGVINI,1),U,12)=DGGRS
Q
;
YEAR(DGMTDT) ;get MAPR year from means test date
Q $$FMTE^XLFDT($E(DGMTDT,1,3)_"0000",1)-2
;
AGME101(DGP1) ;force recalculate gross upon FM change to adjusted
; in: dgp1:~DGVINI = veteran income test ien
; out: queued task
; called from AGME101 x-ref of 408.21/1.01
N DGVINI
S DGVINI=+$G(DGP1)
Q:'DGVINI
Q:'$D(^DGMT(408.21,DGVINI,1))
S $P(^DGMT(408.21,DGVINI,1),U,12)=0
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTSCU4 4019 printed Sep 23, 2025@20:21:23 Page 2
DGMTSCU4 ;ALB/CMF - Means Test Maximum Annual Pension Rate Utilities ;4 OCT 2004 3:33 pm
+1 ;;5.3;Registration;**624**;Aug 13, 1993
+2 ;
+3 QUIT
MEDEXP(DGGRS,DGADJ,DGYR,DGDEP) ;
+1 ; in: DGGRS = gross medical expense, default is 0
+2 ; DGADJ = adjusted medical expense, default is 0
+3 ; DGYR = rate table year
+4 ; DGDEP = # of dependents
+5 ; out: if gross >0, adjusted medical expense
+6 ; if adjusted > 0, gross medical expense (back-compute)
+7 ; else 0
+8 NEW DGRTN,DGMAP,DGPER,DGADD
+9 ; initialize variables, quit if inappropriate
+10 SET DGRTN=0
+11 SET DGGRS=$SELECT(+$GET(DGGRS)>0:DGGRS,1:0)
+12 SET DGADJ=$SELECT(+DGGRS:0,+$GET(DGADJ)>0:DGADJ,1:0)
+13 if (DGGRS=0)&(DGADJ=0)
QUIT DGRTN
+14 SET DGYR=$SELECT(+$GET(DGYR):DGYR,1:-1)
+15 if DGYR=-1
QUIT DGRTN
+16 SET DGDEP=$SELECT(+$GET(DGDEP):+DGDEP,1:0)
+17 ;
+18 ; get global % rate
+19 SET DGPER=$$GET^XPAR("PKG","DGMT MAPR GLOBAL RATE",DGYR)
+20 if DGPER=""
QUIT DGRTN
+21 ;
+22 ; get max annual value
+23 IF DGDEP=0
SET DGMAP=$$GET^XPAR("PKG","DGMT MAPR 0 DEPENDENTS",DGYR)
+24 IF DGDEP>0
SET DGMAP=$$GET^XPAR("PKG","DGMT MAPR 1 DEPENDENTS",DGYR)
+25 SET DGADD=0
+26 if DGDEP>1
Begin DoDot:1
+27 SET DGADD=$$GET^XPAR("PKG","DGMT MAPR N DEPENDENTS",DGYR)
+28 SET DGADD=DGADD*(DGDEP-1)
+29 QUIT
End DoDot:1
+30 ;
+31 SET DGRTN=(DGMAP+DGADD)*DGPER/100
+32 if DGGRS>0
Begin DoDot:1
+33 SET DGRTN=DGGRS-DGRTN
+34 SET DGRTN=$SELECT(DGRTN>0:DGRTN,1:0)
+35 QUIT
End DoDot:1
+36 ;
+37 if DGADJ>0
Begin DoDot:1
+38 SET DGRTN=DGADJ+DGRTN
+39 SET DGRTN=$SELECT(DGRTN>0:DGRTN,1:0)
+40 QUIT
End DoDot:1
+41 ;
+42 QUIT DGRTN
+43 ;
ND(DGP1,DGP2,DGP3) ;return # of deps for a test
+1 ; in: dgp1:DFN = patient ien
+2 ; dgp2:DGMTDT = means test date
+3 ; dgp3:DGVIRI = veteran income relation ien
+4 ; out: DGND = # of dependents for a test
+5 NEW DGDC,DGNC,DGND,DGSP,DGVIR0,DFN,DGMTDT,DGVIRI
+6 SET DFN=+$GET(DGP1)
+7 SET DGMTDT=+$GET(DGP2)
+8 SET DGVIRI=+$GET(DGP3)
+9 if (DFN=0)!(DGMTDT=0)!(DGVIRI=0)
QUIT 0
+10 DO DEP^DGMTSCU2
+11 QUIT $SELECT(DGND<0:0,DGND<21:DGND,1:20)
+12 ;
GRSADJ(DGP1,DGP2,DGP3,DGP4) ;write adjusted medical expense
+1 ;called from [DGMT ENTER/EDIT EXPENSES] edit template
+2 ; in: see $$ADJUST
+3 ; out: text string with adjusted medical expense
+4 NEW DGADJ
+5 SET DGADJ=$$ADJUST(DGP1,DGP2,DGP3,DGP4)
+6 SET DGADJ=$$AMT^DGMTSCU1(DGADJ)
+7 QUIT "ADJUSTED MEDICAL EXPENSES: "_DGADJ_"//"
+8 ;
ADJUST(DGP1,DGP2,DGP3,DGP4) ;derive adjust med exp from gross med exp
+1 ; in: dgp1:DGVINI = veteran income test ien
+2 ; dgp2:DGDFN = patient ien
+3 ; dgp3:DGMTDT = means test date
+4 ; dgp4:DGVIRI = veteran income relation ien
+5 ; out: adjusted medical expense or -1 if not set
+6 NEW DGND,DGYR,DGGRS,DGADJ,DGVINI,DGDFN,DGMTDT,DGVIRI
+7 SET DGVINI=+$GET(DGP1)
+8 SET DGDFN=+$GET(DGP2)
+9 SET DGMTDT=+$GET(DGP3)
+10 SET DGVIRI=+$GET(DGP4)
+11 if (DGVINI=0)!(DGDFN=0)!(DGMTDT=0)!(DGVIRI=0)
QUIT -1
+12 if '$DATA(^DGMT(408.21,DGVINI,1))
QUIT 0
+13 SET DGND=$$ND(DGDFN,DGMTDT,DGVIRI)
+14 SET DGYR=$$YEAR(DGMTDT)
+15 SET DGGRS=$PIECE(^DGMT(408.21,DGVINI,1),U,12)
+16 SET DGADJ=$$MEDEXP(DGGRS,,DGYR,DGND)
+17 SET $PIECE(^DGMT(408.21,DGVINI,1),U)=DGADJ
+18 QUIT DGADJ
+19 ;
GROSS(DGP1,DGP2,DGP3,DGP4) ;derive gross med exp from adj med exp
+1 ; in: dgp1:DGVINI = veteran income test ien
+2 ; dgp2:DGDFN = patient ien
+3 ; dgp3:DGMTDT = means test date
+4 ; dgp4:DGVIRI = veteran income relation ien
+5 ; out: gross medical expense reset if necessary
+6 NEW DGND,DGYR,DGGRS,DGADJ,DGVINI,DGDFN,DGMTDT,DGVIRI
+7 SET DGVINI=+$GET(DGP1)
+8 SET DGDFN=+$GET(DGP2)
+9 SET DGMTDT=+$GET(DGP3)
+10 SET DGVIRI=+$GET(DGP4)
+11 if (DGVINI=0)!(DGDFN=0)!(DGMTDT=0)!(DGVIRI=0)
QUIT
+12 if '$DATA(^DGMT(408.21,DGVINI,1))
QUIT
+13 SET DGGRS=+$PIECE(^DGMT(408.21,DGVINI,1),U,12)
+14 SET DGADJ=+$PIECE(^DGMT(408.21,DGVINI,1),U,1)
+15 if DGGRS+DGADJ=0
QUIT
+16 if DGADJ=0
QUIT
+17 SET DGND=$$ND(DGDFN,DGMTDT,DGVIRI)
+18 SET DGYR=$$YEAR(DGMTDT)
+19 if DGADJ=$$MEDEXP(DGGRS,,DGYR,DGND)
QUIT
+20 SET DGGRS=$$MEDEXP(,DGADJ,DGYR,DGND)
+21 SET $PIECE(^DGMT(408.21,DGVINI,1),U,12)=DGGRS
+22 QUIT
+23 ;
YEAR(DGMTDT) ;get MAPR year from means test date
+1 QUIT $$FMTE^XLFDT($EXTRACT(DGMTDT,1,3)_"0000",1)-2
+2 ;
AGME101(DGP1) ;force recalculate gross upon FM change to adjusted
+1 ; in: dgp1:~DGVINI = veteran income test ien
+2 ; out: queued task
+3 ; called from AGME101 x-ref of 408.21/1.01
+4 NEW DGVINI
+5 SET DGVINI=+$GET(DGP1)
+6 if 'DGVINI
QUIT
+7 if '$DATA(^DGMT(408.21,DGVINI,1))
QUIT
+8 SET $PIECE(^DGMT(408.21,DGVINI,1),U,12)=0
+9 QUIT
+10 ;
