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

DGMTSCU2.m

Go to the documentation of this file.
  1. DGMTSCU2 ;ALB/RMO,CAW,LBD,CKN,LMD - Means Test Screen Variable Utilities ;6 FEB 1992 7:45 am
  1. ;;5.3;Registration;**45,130,433,460,456,490,890**;Aug 13, 1993;Build 40
  1. ;
  1. SET ;Set required means test variables
  1. ; Input -- DFN Patient file IEN
  1. ; DGMTDT Date of Test
  1. ; DGMTYPT Type of Test 1=MT 2=COPAY
  1. ; DGMTI Annual Means Test IEN
  1. ; DGMTPAR Annual Means Test Parameters
  1. ; DGVIRI Veteran Income Relation IEN
  1. ; DGVINI Veteran Individual Annual Income IEN
  1. ; Output -- All output variables in tags DEP, INC^DGMTSCU3, CAT and STA
  1. D DEP,INC^DGMTSCU3,CAT,STA
  1. Q
  1. ;
  1. DEP ;Determine dependent data
  1. ; Input -- DFN Patient file IEN
  1. ; DGMTDT Date of Test
  1. ; DGVIRI Veteran Income Relation IEN
  1. ; Output -- DGVIR0 Veteran Income Relation 0th node
  1. ; DGSP Spouse 1=YES and 0=NO (mt income)
  1. ; DGDC Dependent children 1=YES and 0=NO (mt income)
  1. ; DGNC Number of dependent children
  1. ; DGND Total number of dependents
  1. N DGCNT,DGDEP,DGINR,DGREL,Y
  1. S DGVIR0=$G(^DGMT(408.22,DGVIRI,0)) D ALL^DGMTU21(DFN,"SC",DGMTDT,"PR",$S($G(DGMTI):DGMTI,1:""))
  1. S DGSP=$S('$P(DGVIR0,"^",5)!('$G(DGREL("S"))):0,$P(DGVIR0,"^",6):1,$P(DGVIR0,"^",20)=1:1,1:0) ;DG*5.3*890 Field change to a Y/N response
  1. S DGDC=+$P(DGVIR0,"^",8) I DGDC S (DGDC,DGCNT)=0 F S DGCNT=$O(DGINR("C",DGCNT)) Q:'DGCNT!(DGDC) D CHK S:Y DGDC=1
  1. S DGNC=+$P(DGVIR0,"^",13)
  1. S DGND=DGSP+DGNC
  1. Q
  1. ;
  1. CHK ;Check if child has income which is available to the veteran
  1. S Y=0
  1. I $D(^DGMT(408.22,+$G(DGINR("C",DGCNT)),0)),$P(^(0),"^",11),$P(^(0),"^",12) S Y=1
  1. Q
  1. ;
  1. CAT ;Determine means test thresholds and category
  1. ; Input -- DGMTDT Date of Test
  1. ; DGND Total number of dependents
  1. ; DGINT Total income
  1. ; DGDET Total deductible expenses
  1. ; DGMTPAR Annual Means Test Parameters
  1. ; DGMTGMT GMT Thresholds
  1. ; Output -- DGTHA MT threshold
  1. ; DGTHB Category B threshold (NO LONGER USED)
  1. ; DGTHG GMT threshold
  1. ; DGCAT Means/Copay test category code
  1. N DGCOST,DGCOPS,PCT S DGCAT=""
  1. ; Added for LTC Copay Phase II - DG*5.3*433
  1. I DGMTYPT=4 D Q
  1. .N Y S DGTHA=""
  1. .I $D(DGREF1),$D(DGREF) S DGCAT=1 Q ;Vet declined to give income info
  1. .S Y=$$THRES^EASECMT(DFN,DGMTDT) Q:Y=-1
  1. .S DGCAT=$S(Y:0,1:1)
  1. I $$ACT^DGMTDD(4,DGMTDT) S DGTHA=$P(DGMTPAR,"^",2)+$S(DGND:$P(DGMTPAR,"^",3),1:0)+$S((DGND-1)>0:($P(DGMTPAR,"^",4)*(DGND-1)),1:0) S:(DGINT-DGDET)'>DGTHA DGCAT="A"
  1. I $$ACT^DGMTDD(5,DGMTDT) S DGTHB=$P(DGMTPAR,"^",5)+$S(DGND:$P(DGMTPAR,"^",6),1:0)+$S((DGND-1)>0:($P(DGMTPAR,"^",7)*(DGND-1)),1:0) I DGCAT']"",(DGINT-DGDET)'>DGTHB S DGCAT="B"
  1. ; Determine the GMT Threshold
  1. ; The DGMTGMT variable stores the GMT Thresholds for households of
  1. ; 1-8 persons. If a household (veteran + dependents) has more than 8
  1. ; the GMT Threshold will be calculated. For each person in excess of
  1. ; 8, 8% of the base (4-person household) will be added to the 8-person
  1. ; income limit. Income limits are rounded to the next $50.
  1. S DGTHG=""
  1. I $$ACT^DGMTDD(16,DGMTDT) D
  1. .I '$G(DGMTGMT) S DGTHG=0 Q
  1. .;If GMT Threshold already calculated, don't recalculate
  1. .S DGTHG="" I $G(DGMTI) S DGTHG=$P($G(^DGMT(408.31,DGMTI,0)),"^",27)
  1. .I 'DGTHG D
  1. ..I DGND+1<9 S DGTHG=$P(DGMTGMT,"^",(DGND+1))
  1. ..E S PCT=((DGND+1)-8)*8+132/100,DGTHG=$P(DGMTGMT,"^",4)*PCT,DGTHG=$S(DGTHG#50=0:DGTHG,1:DGTHG+(50-(DGTHG#50)))
  1. .I DGTHG<DGTHA Q
  1. .I DGCAT="",(DGINT-DGDET)'>DGTHG S DGCAT="G"
  1. I DGCAT="",$$ACT^DGMTDD(6,DGMTDT) S DGCAT="C"
  1. I $D(DGREF),DGMTYPT=1,$D(DGREF1) S DGCAT="C"
  1. I DGMTYPT=2 D
  1. .S DGCOST=DGMTDT_U_DFN_U_U_DGINT_U_DGNWT,$P(DGCOST,U,14)=$S($D(DGREF):1,1:0),$P(DGCOST,U,15)=DGDET,$P(DGCOST,U,18)=DGND,$P(DGCOST,U,19)=2
  1. .S DGCOPS=$$INCDT^IBARXEU1(DGCOST)
  1. .S DGCAT=$S(+DGCOPS=1:"E",+DGCOPS=2:"M",+DGCOPS=3:"P",1:"I")
  1. .S (DGTHA,DGTHB)=""
  1. Q
  1. ;
  1. STA ;Determine means test status and type of care
  1. ; Input -- DGCAT Means test category code
  1. ; DGMTYPT Type of Test 1=MT 2=COPAY
  1. ; Output -- DGMTS Means test status IEN
  1. ; DGTYC Type of care
  1. S DGMTS=+$O(^DG(408.32,"AC",DGMTYPT,DGCAT,0))
  1. S DGTYC=$P($G(^DG(408.32,DGMTS,0)),"^",3)
  1. Q