DGMTUTL1 ;ALB/RMM - Means Test Consistency Checker ; 04/28/2005
;;5.3;Registration;**463,542,610,655**;Aug 13, 1993
;
;
Q
; Apply Consistency Checks to the Income Test Processes: ADD,
; EDIT, and COMPLETE.
;
INCON(DFN,DGMTDT,DGMTI,IVMTYPE,IVMERR) ;
;
; Check Income Test before applying consistency checks
; - If AGREED TO PAY DEDUCTIBLE is NO
; - or DECLINES TO GIVE INCOME INFO and AGREED TO PAY DEDUCTIBLE are YES
; Quit, the consistency checks are unnecessary.
N NODE0,APD,DTGII
S NODE0=$G(^DGMT(408.31,DGMTI,0)),APD=$P(NODE0,U,11),DTGII=$P(NODE0,U,14)
I APD=0!(APD=1&(DTGII=1)) Q
;
; Build the data strings for the veteran, and apply consistency checks
; Get information and initialize variables
N CNT,HLFS,IEN,ARRAY,SPOUSE,DEP,DGDEP,DGINC,DGREL,DGINR,ZIR,ZIC,ZMT,ARRAY,DIEN
S CNT=1,HLFS=U,SPOUSE=0,ZIC=""
;
; Build Individual Annual Income and Income Relation Arrays
D ALL^DGMTU21(DFN,"VSC",DGMTDT)
;
; Build ZMT array for CC's
S $P(ARRAY("ZMT"),U,2)=$P($G(^DGMT(408.31,DGMTI,0)),U,1)
S $P(ARRAY("ZMT"),U,2)=$E($P(ARRAY("ZMT"),U,2),1,3)+1700_$E($P(ARRAY("ZMT"),U,2),4,7)
S $P(ARRAY("ZMT"),U,3)=$P($G(^DGMT(408.31,DGMTI,0)),U,3)
S $P(ARRAY("ZMT"),U,3)=$P(^DG(408.32,$P(ARRAY("ZMT"),U,3),0),U,2)
;
; Build Spouse ZIC Arrays
I $D(DGREL("S")) S SPOUSE=1,ARRAY(SPOUSE,"ZIC")=$$ZIC^DGMTUTL2(DGINC("S"),SPOUSE),ARRAY(SPOUSE,"ZIR")=$$ZIR^DGMTUTL2(DGINR("S")),ARRAY(SPOUSE,"ZDP")=$$ZDP^DGMTUTL2(DGREL("S"),SPOUSE)
I SPOUSE D ZDP^IVMCMF2(ARRAY(SPOUSE,"ZDP"))
;
; Build Dependent ZDP, ZIC & ZIR Arrays
F IEN=1:1:DGDEP S DIEN=IEN+SPOUSE,ARRAY(DIEN,"ZDP")=$$ZDP^DGMTUTL2(DGREL("C",IEN),DIEN),ARRAY(DIEN,"ZIC")=$$ZIC^DGMTUTL2(DGINC("C",IEN),DIEN),ARRAY(DIEN,"ZIR")=$$ZIR^DGMTUTL2(DGINR("C",IEN),DIEN)
S DEP=DGDEP+SPOUSE
;
; Perform the inconsistency Checks for the Veteran
I $D(DGINR("V")) D
.S ZIC=$$ZIC^DGMTUTL2(DGINC("V"))
.S ZIR=$$ZIR^DGMTUTL2(DGINR("V"),DGMTDT)
.D ZIR^IVMCMF1(ZIR,"")
;
I "^1^2^4^"[("^"_IVMTYPE_"^"),(ZIC'="") D
.S ZMT=$$ZMT^DGMTUTL2(DGMTI)
.M ARRAY("ZIC")=ZIC
.D ZMT^IVMCMF2(ZMT)
;
; Perform the Consistency Checks for the dependent(s)
F IEN=(SPOUSE+1):1:DEP D ZDP^IVMCMF2(ARRAY(IEN,"ZDP")),ZIR^IVMCMF1(ARRAY(IEN,"ZIR"),IEN),ZIC^IVMCMF1(ARRAY(IEN,"ZIC"),IEN)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTUTL1 2287 printed Oct 16, 2024@18:46:20 Page 2
DGMTUTL1 ;ALB/RMM - Means Test Consistency Checker ; 04/28/2005
+1 ;;5.3;Registration;**463,542,610,655**;Aug 13, 1993
+2 ;
+3 ;
+4 QUIT
+5 ; Apply Consistency Checks to the Income Test Processes: ADD,
+6 ; EDIT, and COMPLETE.
+7 ;
INCON(DFN,DGMTDT,DGMTI,IVMTYPE,IVMERR) ;
+1 ;
+2 ; Check Income Test before applying consistency checks
+3 ; - If AGREED TO PAY DEDUCTIBLE is NO
+4 ; - or DECLINES TO GIVE INCOME INFO and AGREED TO PAY DEDUCTIBLE are YES
+5 ; Quit, the consistency checks are unnecessary.
+6 NEW NODE0,APD,DTGII
+7 SET NODE0=$GET(^DGMT(408.31,DGMTI,0))
SET APD=$PIECE(NODE0,U,11)
SET DTGII=$PIECE(NODE0,U,14)
+8 IF APD=0!(APD=1&(DTGII=1))
QUIT
+9 ;
+10 ; Build the data strings for the veteran, and apply consistency checks
+11 ; Get information and initialize variables
+12 NEW CNT,HLFS,IEN,ARRAY,SPOUSE,DEP,DGDEP,DGINC,DGREL,DGINR,ZIR,ZIC,ZMT,ARRAY,DIEN
+13 SET CNT=1
SET HLFS=U
SET SPOUSE=0
SET ZIC=""
+14 ;
+15 ; Build Individual Annual Income and Income Relation Arrays
+16 DO ALL^DGMTU21(DFN,"VSC",DGMTDT)
+17 ;
+18 ; Build ZMT array for CC's
+19 SET $PIECE(ARRAY("ZMT"),U,2)=$PIECE($GET(^DGMT(408.31,DGMTI,0)),U,1)
+20 SET $PIECE(ARRAY("ZMT"),U,2)=$EXTRACT($PIECE(ARRAY("ZMT"),U,2),1,3)+1700_$EXTRACT($PIECE(ARRAY("ZMT"),U,2),4,7)
+21 SET $PIECE(ARRAY("ZMT"),U,3)=$PIECE($GET(^DGMT(408.31,DGMTI,0)),U,3)
+22 SET $PIECE(ARRAY("ZMT"),U,3)=$PIECE(^DG(408.32,$PIECE(ARRAY("ZMT"),U,3),0),U,2)
+23 ;
+24 ; Build Spouse ZIC Arrays
+25 IF $DATA(DGREL("S"))
SET SPOUSE=1
SET ARRAY(SPOUSE,"ZIC")=$$ZIC^DGMTUTL2(DGINC("S"),SPOUSE)
SET ARRAY(SPOUSE,"ZIR")=$$ZIR^DGMTUTL2(DGINR("S"))
SET ARRAY(SPOUSE,"ZDP")=$$ZDP^DGMTUTL2(DGREL("S"),SPOUSE)
+26 IF SPOUSE
DO ZDP^IVMCMF2(ARRAY(SPOUSE,"ZDP"))
+27 ;
+28 ; Build Dependent ZDP, ZIC & ZIR Arrays
+29 FOR IEN=1:1:DGDEP
SET DIEN=IEN+SPOUSE
SET ARRAY(DIEN,"ZDP")=$$ZDP^DGMTUTL2(DGREL("C",IEN),DIEN)
SET ARRAY(DIEN,"ZIC")=$$ZIC^DGMTUTL2(DGINC("C",IEN),DIEN)
SET ARRAY(DIEN,"ZIR")=$$ZIR^DGMTUTL2(DGINR("C",IEN),DIEN)
+30 SET DEP=DGDEP+SPOUSE
+31 ;
+32 ; Perform the inconsistency Checks for the Veteran
+33 IF $DATA(DGINR("V"))
Begin DoDot:1
+34 SET ZIC=$$ZIC^DGMTUTL2(DGINC("V"))
+35 SET ZIR=$$ZIR^DGMTUTL2(DGINR("V"),DGMTDT)
+36 DO ZIR^IVMCMF1(ZIR,"")
End DoDot:1
+37 ;
+38 IF "^1^2^4^"[("^"_IVMTYPE_"^")
IF (ZIC'="")
Begin DoDot:1
+39 SET ZMT=$$ZMT^DGMTUTL2(DGMTI)
+40 MERGE ARRAY("ZIC")=ZIC
+41 DO ZMT^IVMCMF2(ZMT)
End DoDot:1
+42 ;
+43 ; Perform the Consistency Checks for the dependent(s)
+44 FOR IEN=(SPOUSE+1):1:DEP
DO ZDP^IVMCMF2(ARRAY(IEN,"ZDP"))
DO ZIR^IVMCMF1(ARRAY(IEN,"ZIR"),IEN)
DO ZIC^IVMCMF1(ARRAY(IEN,"ZIC"),IEN)
+45 ;
+46 QUIT
