DGMTSCU2 ;ALB/RMO,CAW,LBD,CKN,LMD - Means Test Screen Variable Utilities ;6 FEB 1992 7:45 am
;;5.3;Registration;**45,130,433,460,456,490,890**;Aug 13, 1993;Build 40
;
SET ;Set required means test variables
; Input -- DFN Patient file IEN
; DGMTDT Date of Test
; DGMTYPT Type of Test 1=MT 2=COPAY
; DGMTI Annual Means Test IEN
; DGMTPAR Annual Means Test Parameters
; DGVIRI Veteran Income Relation IEN
; DGVINI Veteran Individual Annual Income IEN
; Output -- All output variables in tags DEP, INC^DGMTSCU3, CAT and STA
D DEP,INC^DGMTSCU3,CAT,STA
Q
;
DEP ;Determine dependent data
; Input -- DFN Patient file IEN
; DGMTDT Date of Test
; DGVIRI Veteran Income Relation IEN
; Output -- DGVIR0 Veteran Income Relation 0th node
; DGSP Spouse 1=YES and 0=NO (mt income)
; DGDC Dependent children 1=YES and 0=NO (mt income)
; DGNC Number of dependent children
; DGND Total number of dependents
N DGCNT,DGDEP,DGINR,DGREL,Y
S DGVIR0=$G(^DGMT(408.22,DGVIRI,0)) D ALL^DGMTU21(DFN,"SC",DGMTDT,"PR",$S($G(DGMTI):DGMTI,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
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
S DGNC=+$P(DGVIR0,"^",13)
S DGND=DGSP+DGNC
Q
;
CHK ;Check if child has income which is available to the veteran
S Y=0
I $D(^DGMT(408.22,+$G(DGINR("C",DGCNT)),0)),$P(^(0),"^",11),$P(^(0),"^",12) S Y=1
Q
;
CAT ;Determine means test thresholds and category
; Input -- DGMTDT Date of Test
; DGND Total number of dependents
; DGINT Total income
; DGDET Total deductible expenses
; DGMTPAR Annual Means Test Parameters
; DGMTGMT GMT Thresholds
; Output -- DGTHA MT threshold
; DGTHB Category B threshold (NO LONGER USED)
; DGTHG GMT threshold
; DGCAT Means/Copay test category code
N DGCOST,DGCOPS,PCT S DGCAT=""
; Added for LTC Copay Phase II - DG*5.3*433
I DGMTYPT=4 D Q
.N Y S DGTHA=""
.I $D(DGREF1),$D(DGREF) S DGCAT=1 Q ;Vet declined to give income info
.S Y=$$THRES^EASECMT(DFN,DGMTDT) Q:Y=-1
.S DGCAT=$S(Y:0,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"
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"
; Determine the GMT Threshold
; The DGMTGMT variable stores the GMT Thresholds for households of
; 1-8 persons. If a household (veteran + dependents) has more than 8
; the GMT Threshold will be calculated. For each person in excess of
; 8, 8% of the base (4-person household) will be added to the 8-person
; income limit. Income limits are rounded to the next $50.
S DGTHG=""
I $$ACT^DGMTDD(16,DGMTDT) D
.I '$G(DGMTGMT) S DGTHG=0 Q
.;If GMT Threshold already calculated, don't recalculate
.S DGTHG="" I $G(DGMTI) S DGTHG=$P($G(^DGMT(408.31,DGMTI,0)),"^",27)
.I 'DGTHG D
..I DGND+1<9 S DGTHG=$P(DGMTGMT,"^",(DGND+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)))
.I DGTHG<DGTHA Q
.I DGCAT="",(DGINT-DGDET)'>DGTHG S DGCAT="G"
I DGCAT="",$$ACT^DGMTDD(6,DGMTDT) S DGCAT="C"
I $D(DGREF),DGMTYPT=1,$D(DGREF1) S DGCAT="C"
I DGMTYPT=2 D
.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
.S DGCOPS=$$INCDT^IBARXEU1(DGCOST)
.S DGCAT=$S(+DGCOPS=1:"E",+DGCOPS=2:"M",+DGCOPS=3:"P",1:"I")
.S (DGTHA,DGTHB)=""
Q
;
STA ;Determine means test status and type of care
; Input -- DGCAT Means test category code
; DGMTYPT Type of Test 1=MT 2=COPAY
; Output -- DGMTS Means test status IEN
; DGTYC Type of care
S DGMTS=+$O(^DG(408.32,"AC",DGMTYPT,DGCAT,0))
S DGTYC=$P($G(^DG(408.32,DGMTS,0)),"^",3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTSCU2 4324 printed Apr 09, 2024@21:58:15 Page 2
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
+2 ;
SET ;Set required means test variables
+1 ; Input -- DFN Patient file IEN
+2 ; DGMTDT Date of Test
+3 ; DGMTYPT Type of Test 1=MT 2=COPAY
+4 ; DGMTI Annual Means Test IEN
+5 ; DGMTPAR Annual Means Test Parameters
+6 ; DGVIRI Veteran Income Relation IEN
+7 ; DGVINI Veteran Individual Annual Income IEN
+8 ; Output -- All output variables in tags DEP, INC^DGMTSCU3, CAT and STA
+9 DO DEP
DO INC^DGMTSCU3
DO CAT
DO STA
+10 QUIT
+11 ;
DEP ;Determine dependent data
+1 ; Input -- DFN Patient file IEN
+2 ; DGMTDT Date of Test
+3 ; DGVIRI Veteran Income Relation IEN
+4 ; Output -- DGVIR0 Veteran Income Relation 0th node
+5 ; DGSP Spouse 1=YES and 0=NO (mt income)
+6 ; DGDC Dependent children 1=YES and 0=NO (mt income)
+7 ; DGNC Number of dependent children
+8 ; DGND Total number of dependents
+9 NEW DGCNT,DGDEP,DGINR,DGREL,Y
+10 SET DGVIR0=$GET(^DGMT(408.22,DGVIRI,0))
DO ALL^DGMTU21(DFN,"SC",DGMTDT,"PR",$SELECT($GET(DGMTI):DGMTI,1:""))
+11 ;DG*5.3*890 Field change to a Y/N response
SET DGSP=$SELECT('$PIECE(DGVIR0,"^",5)!('$GET(DGREL("S"))):0,$PIECE(DGVIR0,"^",6):1,$PIECE(DGVIR0,"^",20)=1:1,1:0)
+12 SET DGDC=+$PIECE(DGVIR0,"^",8)
IF DGDC
SET (DGDC,DGCNT)=0
FOR
SET DGCNT=$ORDER(DGINR("C",DGCNT))
if 'DGCNT!(DGDC)
QUIT
DO CHK
if Y
SET DGDC=1
+13 SET DGNC=+$PIECE(DGVIR0,"^",13)
+14 SET DGND=DGSP+DGNC
+15 QUIT
+16 ;
CHK ;Check if child has income which is available to the veteran
+1 SET Y=0
+2 IF $DATA(^DGMT(408.22,+$GET(DGINR("C",DGCNT)),0))
IF $PIECE(^(0),"^",11)
IF $PIECE(^(0),"^",12)
SET Y=1
+3 QUIT
+4 ;
CAT ;Determine means test thresholds and category
+1 ; Input -- DGMTDT Date of Test
+2 ; DGND Total number of dependents
+3 ; DGINT Total income
+4 ; DGDET Total deductible expenses
+5 ; DGMTPAR Annual Means Test Parameters
+6 ; DGMTGMT GMT Thresholds
+7 ; Output -- DGTHA MT threshold
+8 ; DGTHB Category B threshold (NO LONGER USED)
+9 ; DGTHG GMT threshold
+10 ; DGCAT Means/Copay test category code
+11 NEW DGCOST,DGCOPS,PCT
SET DGCAT=""
+12 ; Added for LTC Copay Phase II - DG*5.3*433
+13 IF DGMTYPT=4
Begin DoDot:1
+14 NEW Y
SET DGTHA=""
+15 ;Vet declined to give income info
IF $DATA(DGREF1)
IF $DATA(DGREF)
SET DGCAT=1
QUIT
+16 SET Y=$$THRES^EASECMT(DFN,DGMTDT)
if Y=-1
QUIT
+17 SET DGCAT=$SELECT(Y:0,1:1)
End DoDot:1
QUIT
+18 IF $$ACT^DGMTDD(4,DGMTDT)
SET DGTHA=$PIECE(DGMTPAR,"^",2)+$SELECT(DGND:$PIECE(DGMTPAR,"^",3),1:0)+$SELECT((DGND-1)>0:($PIECE(DGMTPAR,"^",4)*(DGND-1)),1:0)
if (DGINT-DGDET)'>DGTHA
SET DGCAT="A"
+19 IF $$ACT^DGMTDD(5,DGMTDT)
SET DGTHB=$PIECE(DGMTPAR,"^",5)+$SELECT(DGND:$PIECE(DGMTPAR,"^",6),1:0)+$SELECT((DGND-1)>0:($PIECE(DGMTPAR,"^",7)*(DGND-1)),1:0)
IF DGCAT']""
IF (DGINT-DGDET)'>DGTHB
SET DGCAT="B"
+20 ; Determine the GMT Threshold
+21 ; The DGMTGMT variable stores the GMT Thresholds for households of
+22 ; 1-8 persons. If a household (veteran + dependents) has more than 8
+23 ; the GMT Threshold will be calculated. For each person in excess of
+24 ; 8, 8% of the base (4-person household) will be added to the 8-person
+25 ; income limit. Income limits are rounded to the next $50.
+26 SET DGTHG=""
+27 IF $$ACT^DGMTDD(16,DGMTDT)
Begin DoDot:1
+28 IF '$GET(DGMTGMT)
SET DGTHG=0
QUIT
+29 ;If GMT Threshold already calculated, don't recalculate
+30 SET DGTHG=""
IF $GET(DGMTI)
SET DGTHG=$PIECE($GET(^DGMT(408.31,DGMTI,0)),"^",27)
+31 IF 'DGTHG
Begin DoDot:2
+32 IF DGND+1<9
SET DGTHG=$PIECE(DGMTGMT,"^",(DGND+1))
+33 IF '$TEST
SET PCT=((DGND+1)-8)*8+132/100
SET DGTHG=$PIECE(DGMTGMT,"^",4)*PCT
SET DGTHG=$SELECT(DGTHG#50=0:DGTHG,1:DGTHG+(50-(DGTHG#50)))
End DoDot:2
+34 IF DGTHG<DGTHA
QUIT
+35 IF DGCAT=""
IF (DGINT-DGDET)'>DGTHG
SET DGCAT="G"
End DoDot:1
+36 IF DGCAT=""
IF $$ACT^DGMTDD(6,DGMTDT)
SET DGCAT="C"
+37 IF $DATA(DGREF)
IF DGMTYPT=1
IF $DATA(DGREF1)
SET DGCAT="C"
+38 IF DGMTYPT=2
Begin DoDot:1
+39 SET DGCOST=DGMTDT_U_DFN_U_U_DGINT_U_DGNWT
SET $PIECE(DGCOST,U,14)=$SELECT($DATA(DGREF):1,1:0)
SET $PIECE(DGCOST,U,15)=DGDET
SET $PIECE(DGCOST,U,18)=DGND
SET $PIECE(DGCOST,U,19)=2
+40 SET DGCOPS=$$INCDT^IBARXEU1(DGCOST)
+41 SET DGCAT=$SELECT(+DGCOPS=1:"E",+DGCOPS=2:"M",+DGCOPS=3:"P",1:"I")
+42 SET (DGTHA,DGTHB)=""
End DoDot:1
+43 QUIT
+44 ;
STA ;Determine means test status and type of care
+1 ; Input -- DGCAT Means test category code
+2 ; DGMTYPT Type of Test 1=MT 2=COPAY
+3 ; Output -- DGMTS Means test status IEN
+4 ; DGTYC Type of care
+5 SET DGMTS=+$ORDER(^DG(408.32,"AC",DGMTYPT,DGCAT,0))
+6 SET DGTYC=$PIECE($GET(^DG(408.32,DGMTS,0)),"^",3)
+7 QUIT
