Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGMTSCU4

DGMTSCU4.m

Go to the documentation of this file. 
  1. DGMTSCU4 ;ALB/CMF - Means Test Maximum Annual Pension Rate Utilities ;4 OCT 2004 3:33 pm
  1.  ;;5.3;Registration;**624,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  Q
  1. MEDEXP(DGGRS,DGADJ,DGYR,DGDEP) ;
  1.  ; in:   DGGRS = gross medical expense, default is 0
  1.  ;       DGADJ = adjusted medical expense, default is 0
  1.  ;       DGYR  = rate table year
  1.  ;       DGDEP = # of dependents
  1.  ; out:  if gross >0, adjusted medical expense
  1.  ;       if adjusted > 0, gross medical expense (back-compute)
  1.  ;       else 0
  1.  N DGRTN,DGMAP,DGPER,DGADD
  1.  ; initialize variables, quit if inappropriate
  1.  S DGRTN=0
  1.  S DGGRS=$S(+$G(DGGRS)>0:DGGRS,1:0)
  1.  S DGADJ=$S(+DGGRS:0,+$G(DGADJ)>0:DGADJ,1:0)
  1.  Q:(DGGRS=0)&(DGADJ=0) DGRTN
  1.  S DGYR=$S(+$G(DGYR):DGYR,1:-1)
  1.  Q:DGYR=-1 DGRTN
  1.  S DGDEP=$S(+$G(DGDEP):+DGDEP,1:0)
  1.  ;
  1.  ; get global % rate
  1.  S DGPER=$$GET^XPAR("PKG","DGMT MAPR GLOBAL RATE",DGYR)
  1.  Q:DGPER="" DGRTN
  1.  ;
  1.  ; get max annual value
  1.  I DGDEP=0 S DGMAP=$$GET^XPAR("PKG","DGMT MAPR 0 DEPENDENTS",DGYR)
  1.  I DGDEP>0 S DGMAP=$$GET^XPAR("PKG","DGMT MAPR 1 DEPENDENTS",DGYR)
  1.  S DGADD=0
  1.  D:DGDEP>1
  1.  .S DGADD=$$GET^XPAR("PKG","DGMT MAPR N DEPENDENTS",DGYR)
  1.  .S DGADD=DGADD*(DGDEP-1)
  1.  .Q
  1.  ;
  1.  S DGRTN=(DGMAP+DGADD)*DGPER/100
  1.  D:DGGRS>0
  1.  .S DGRTN=DGGRS-DGRTN
  1.  .S DGRTN=$S(DGRTN>0:DGRTN,1:0)
  1.  .Q
  1.  ;
  1.  D:DGADJ>0
  1.  .S DGRTN=DGADJ+DGRTN
  1.  .S DGRTN=$S(DGRTN>0:DGRTN,1:0)
  1.  .Q
  1.  ;
  1.  Q DGRTN
  1.  ;
  1. ND(DGP1,DGP2,DGP3) ;return # of deps for a test
  1.  ; in:   dgp1:DFN = patient ien
  1.  ;       dgp2:DGMTDT = means test date
  1.  ;       dgp3:DGVIRI = veteran income relation ien
  1.  ; out:  DGND = # of dependents for a test 
  1.  N DGDC,DGNC,DGND,DGSP,DGVIR0,DFN,DGMTDT,DGVIRI
  1.  S DFN=+$G(DGP1)
  1.  S DGMTDT=+$G(DGP2)
  1.  S DGVIRI=+$G(DGP3)
  1.  Q:(DFN=0)!(DGMTDT=0)!(DGVIRI=0) 0
  1.  D DEP^DGMTSCU2
  1.  Q $S(DGND<0:0,DGND<21:DGND,1:20)
  1.  ;
  1. GRSADJ(DGP1,DGP2,DGP3,DGP4) ;write adjusted medical expense
  1.  ;called from [DGMT ENTER/EDIT EXPENSES] edit template
  1.  ; in:   see $$ADJUST
  1.  ; out:  text string with adjusted medical expense
  1.  N DGADJ
  1.  S DGADJ=$$ADJUST(DGP1,DGP2,DGP3,DGP4)
  1.  S DGADJ=$$AMT^DGMTSCU1(DGADJ)
  1.  Q "ADJUSTED MEDICAL EXPENSES: "_DGADJ_"//"
  1.  ;
  1. ADJUST(DGP1,DGP2,DGP3,DGP4) ;derive adjust med exp from gross med exp
  1.  ; in:   dgp1:DGVINI = veteran income test ien
  1.  ;       dgp2:DGDFN = patient ien
  1.  ;       dgp3:DGMTDT = means test date
  1.  ;       dgp4:DGVIRI = veteran income relation ien
  1.  ; out:  adjusted medical expense or -1 if not set
  1.  N DGND,DGYR,DGGRS,DGADJ,DGVINI,DGDFN,DGMTDT,DGVIRI
  1.  S DGVINI=+$G(DGP1)
  1.  S DGDFN=+$G(DGP2)
  1.  S DGMTDT=+$G(DGP3)
  1.  S DGVIRI=+$G(DGP4)
  1.  Q:(DGVINI=0)!(DGDFN=0)!(DGMTDT=0)!(DGVIRI=0) -1
  1.  Q:'$D(^DGMT(408.21,DGVINI,1)) 0
  1.  S DGND=$$ND(DGDFN,DGMTDT,DGVIRI)
  1.  S DGYR=$$YEAR(DGMTDT)
  1.  S DGGRS=$P(^DGMT(408.21,DGVINI,1),U,12)
  1.  S DGADJ=$$MEDEXP(DGGRS,,DGYR,DGND)
  1.  S $P(^DGMT(408.21,DGVINI,1),U)=DGADJ
  1.  Q DGADJ
  1.  ;
  1. GROSS(DGP1,DGP2,DGP3,DGP4) ;derive gross med exp from adj med exp
  1.  ; in:   dgp1:DGVINI = veteran income test ien
  1.  ;       dgp2:DGDFN = patient ien
  1.  ;       dgp3:DGMTDT = means test date
  1.  ;       dgp4:DGVIRI = veteran income relation ien
  1.  ; out:  gross medical expense reset if necessary
  1.  N DGND,DGYR,DGGRS,DGADJ,DGVINI,DGDFN,DGMTDT,DGVIRI
  1.  S DGVINI=+$G(DGP1)
  1.  S DGDFN=+$G(DGP2)
  1.  S DGMTDT=+$G(DGP3)
  1.  S DGVIRI=+$G(DGP4)
  1.  Q:(DGVINI=0)!(DGDFN=0)!(DGMTDT=0)!(DGVIRI=0)
  1.  Q:'$D(^DGMT(408.21,DGVINI,1))
  1.  S DGGRS=+$P(^DGMT(408.21,DGVINI,1),U,12)
  1.  S DGADJ=+$P(^DGMT(408.21,DGVINI,1),U,1)
  1.  Q:DGGRS+DGADJ=0
  1.  Q:DGADJ=0
  1.  S DGND=$$ND(DGDFN,DGMTDT,DGVIRI)
  1.  S DGYR=$$YEAR(DGMTDT)
  1.  Q:DGADJ=$$MEDEXP(DGGRS,,DGYR,DGND)
  1.  S DGGRS=$$MEDEXP(,DGADJ,DGYR,DGND)
  1.  S $P(^DGMT(408.21,DGVINI,1),U,12)=DGGRS
  1.  Q
  1.  ;
  1. YEAR(DGMTDT) ;get MAPR year from means test date
  1.  Q $$FMTE^XLFDT($E(DGMTDT,1,3)_"0000",1)-2
  1.  ;
  1. AGME101(DGP1) ;force recalculate gross upon FM change to adjusted
  1.  ; in:   dgp1:~DGVINI = veteran income test ien
  1.  ; out:  queued task
  1.  ; called from AGME101 x-ref of 408.21/1.01
  1.  N DGVINI
  1.  S DGVINI=+$G(DGP1)
  1.  Q:'DGVINI
  1.  Q:'$D(^DGMT(408.21,DGVINI,1))
  1.  S $P(^DGMT(408.21,DGVINI,1),U,12)=0
  1.  Q
  1.  ;