- 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 Jan 18, 2025@03:46:10 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