DGMTDD2 ;ALB/RMO,LBD - Income Relation file (#408.22) Data Dictionary Calls ;13 MAR 1992 3:00 pm
;;5.3;Registration;**33,45,518,688**;Aug 13, 1993;Build 29
;
ID ;Identifier for Income Relation file
N DGIN0,DGPRI,Y
S DGIN0=$G(^DGMT(408.21,+$P($G(^(0)),U,2),0))
S DGPRI=+$P(DGIN0,U,2),Y=+DGIN0 X ^DD("DD")
W " ",Y W:$P($G(^DGPR(408.12,DGPRI,0)),U,2)'=1 " Relation: ",$$NAME^DGMTU1(DGPRI)," (",$$REL^DGMTU1(DGPRI),")" W !
Q
;
FUN ;"Trigger" Cross-reference on the Married field (#.05) and
;Dependent Children field (#.08) to delete funeral and burial
;expenses
; If the test is a LTC Copay test do not delete the funeral and
; burial expenses. Added for LTC Phase III (DG*5.3*518)
N DGFLD,DGIN0,DGINI,DGVAL,DGMT,DGMTIR ;DG5.3*688 added DGMTIR
S DGINI=+$P($G(^DGMT(408.22,DA,0)),U,2),DGIN1=$G(^DGMT(408.21,DGINI,1))
S DGMTIR=$P($G(^DGMT(408.22,DA,"MT")),U) ;DG5.3*688 defines DGMTIR
S DGMT=+$G(^DGMT(408.21,DGINI,"MT"))
I DGMT,$P($G(^DGMT(408.31,DGMT,0)),U,19)=3 Q
I DGMT,$P($G(^DGMT(408.31,DGMT,2)),U,11)=1 Q ;* GTS DG*688 - MT V1 does not require Spouse or Children for F&B
I DGMTIR,$P($G(^DGMT(408.31,DGMTIR,2)),U,11)=1 Q ;* DG*688 - Check for Version 1 using 408.22 MT Ptr
S DGFLD=1.02,DGVAL=$P(DGIN1,U,2)
I DGVAL]"" D KILL S $P(^DGMT(408.21,DGINI,1),U,2)=""
Q
;
SP ;"Trigger" Cross-reference on the Amount Contributed to Spouse field
;(#.07) to delete net worth on file for a spouse
N DFN,DGIN2,DGINI,DGLY,DGREL,DGVAL
S DGIR0=$G(^DGMT(408.22,DA,0))
S DFN=+DGIR0,DGLY=+$G(^DGMT(408.21,+$P(DGIR0,U,2),0)) D
.N DA,X
.D GETREL^DGMTU11(DFN,"S",DGLY,$S($G(DGMTI):DGMTI,1:""))
S DGINI=+$$IAI^DGMTU3(+$G(DGREL("S")),DGLY)
S DGIN2=$G(^DGMT(408.21,DGINI,2))
F DGFLD=2.01:.01:2.05 S DGVAL=$P(DGIN2,U,(DGFLD-2)/.01) I DGVAL]"" D
.D KILL
.S $P(^DGMT(408.21,DGINI,2),U,(DGFLD-2)/.01)=""
Q
;
INC ;"Trigger" Cross-reference on the Child Had Income field (#.11) and
;Income Available To You field (#.12) to delete educational expenses
;on file for a child
N DGINI
S DGINI=+$P($G(^DGMT(408.22,DA,0)),U,2)
I $P($G(^DGMT(408.21,DGINI,0)),U,14)]"" D
.N DGFLD,DGVAL
.I $P($G(^DGMT(408.21,DGINI,1)),U,3)]"" S DGVAL=$P(^(1),U,3),DGFLD=1.03 D KILL S $P(^DGMT(408.21,DGINI,1),U,3)=""
Q
KILL ;Kill Cross-Reference
N DA,DGIX,X
S DA=DGINI,X=DGVAL,DGIX=0
F S DGIX=$O(^DD(408.21,DGFLD,1,DGIX)) Q:'DGIX X ^(DGIX,2) S X=DGVAL
Q
;
MAR ;Input Transform check for the Married field (#.05)
;for an active spouse
N DFN,DGIR0,DGLY,DGREL
S DGIR0=$G(^DGMT(408.22,DA,0))
S DFN=+DGIR0,DGLY=+$G(^DGMT(408.21,+$P(DGIR0,U,2),0)) D
.N DA,X
.D GETREL^DGMTU11(DFN,"S",DGLY,$S($G(DGMTI):DGMTI,1:""))
I $D(DGREL("S")) W !?5,"An active spouse exists. Married cannot be 'NO'.",!?5,"You have to use the 'Expand Dependent' action and inactive first." K X
Q
;
DEP ;Input Transform check for the Dependent Children field (#.08)
;for active children
N DFN,DGDEP,DGIR0,DGLY,DGREL
S DGIR0=$G(^DGMT(408.22,DA,0))
S DFN=+DGIR0,DGLY=+$G(^DGMT(408.21,+$P(DGIR0,U,2),0)) D
.N DA,X
.D GETREL^DGMTU11(DFN,"C",DGLY,$S($G(DGMTI):DGMTI,1:""))
I $D(DGREL("C")) W !?5,"Active children exist. Dependent Children cannot be 'NO'." K X
Q
;
LIV ;Input Transform check for Lived With Patient field (#.06)
N DGIR0,DGPRI
S DGIR0=$G(^DGMT(408.22,DA,0)),DGPRI=+$P($G(^DGMT(408.21,+$P(DGIR0,U,2),0)),U,2)
I $P($G(^DGPR(408.12,DGPRI,0)),U,2)=1,'$P(DGIR0,U,5) W !?5,"This field does not need to be filled in unless the patient is married." K X
Q
;
AMT ;Input Transform check for Amount Contributed To Spouse field (#.07)
N DGIR0,DGPRI
S DGIR0=$G(^DGMT(408.22,DA,0)),DGPRI=+$P($G(^DGMT(408.21,+$P(DGIR0,U,2),0)),U,2)
I $P($G(^DGPR(408.12,DGPRI,0)),U,2)=1,('$P(DGIR0,U,5)!($P(DGIR0,U,6)'=0)) W !?5,"This field does not need to be filled in unless the patient was married",!?5,"and did not live with his or her spouse." K X
Q
;
CON ;Input Transform check for Contributed To Support field (#.1)
N DGIR0,DGPRI
S DGIR0=$G(^DGMT(408.22,DA,0)),DGPRI=+$P($G(^DGMT(408.21,+$P(DGIR0,U,2),0)),U,2)
I "^3^4^5^6^"[(U_$P($G(^DGPR(408.12,DGPRI,0)),U,2)_U),$P(DGIR0,U,6)'=0 W !?5,"This field does not need to be filled in unless the child did not",!?5,"live with the patient." K X
Q
;
AVL ;Input Transform check for Income Available To You field (#.12)
I '$P($G(^DGMT(408.22,DA,0)),U,11) W !?5,"This field does not need to be filled in unless the child has income." K X
Q
;
NAM ;Output Transform for Individual Annual Income field (#.02)
N DGIN0,DGPRI
S DGIN0=$G(^DGMT(408.21,Y,0)),DGPRI=+$P(DGIN0,U,2),Y=+DGIN0 X ^DD("DD")
S Y=Y_" "_$$NAME^DGMTU1(DGPRI)
Q
;
LIVHLP ;Help for Lived With Patient field (#.06)
N DGIR0,DGPRI
S DGIR0=$G(^DGMT(408.22,DA,0)),DGPRI=+$P($G(^DGMT(408.21,+$P(DGIR0,U,2),0)),U,2)
I $P($G(^DGPR(408.12,DGPRI,0)),U,2)=1 W !?5,"Enter in this field whether the veteran resided with his or her spouse",!?5,"last calendar year. If they were living apart because one was",!?5,"hospitalized or in a nursing home, enter 'YES'."
I "^3^4^5^6^"[(U_$P($G(^DGPR(408.12,DGPRI,0)),U,2)_U) W !?5,"Enter in this field whether the child resided with the veteran last",!?5,"calendar year."
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTDD2 5220 printed Dec 13, 2024@02:44:45 Page 2
DGMTDD2 ;ALB/RMO,LBD - Income Relation file (#408.22) Data Dictionary Calls ;13 MAR 1992 3:00 pm
+1 ;;5.3;Registration;**33,45,518,688**;Aug 13, 1993;Build 29
+2 ;
ID ;Identifier for Income Relation file
+1 NEW DGIN0,DGPRI,Y
+2 SET DGIN0=$GET(^DGMT(408.21,+$PIECE($GET(^(0)),U,2),0))
+3 SET DGPRI=+$PIECE(DGIN0,U,2)
SET Y=+DGIN0
XECUTE ^DD("DD")
+4 WRITE " ",Y
if $PIECE($GET(^DGPR(408.12,DGPRI,0)),U,2)'=1
WRITE " Relation: ",$$NAME^DGMTU1(DGPRI)," (",$$REL^DGMTU1(DGPRI),")"
WRITE !
+5 QUIT
+6 ;
FUN ;"Trigger" Cross-reference on the Married field (#.05) and
+1 ;Dependent Children field (#.08) to delete funeral and burial
+2 ;expenses
+3 ; If the test is a LTC Copay test do not delete the funeral and
+4 ; burial expenses. Added for LTC Phase III (DG*5.3*518)
+5 ;DG5.3*688 added DGMTIR
NEW DGFLD,DGIN0,DGINI,DGVAL,DGMT,DGMTIR
+6 SET DGINI=+$PIECE($GET(^DGMT(408.22,DA,0)),U,2)
SET DGIN1=$GET(^DGMT(408.21,DGINI,1))
+7 ;DG5.3*688 defines DGMTIR
SET DGMTIR=$PIECE($GET(^DGMT(408.22,DA,"MT")),U)
+8 SET DGMT=+$GET(^DGMT(408.21,DGINI,"MT"))
+9 IF DGMT
IF $PIECE($GET(^DGMT(408.31,DGMT,0)),U,19)=3
QUIT
+10 ;* GTS DG*688 - MT V1 does not require Spouse or Children for F&B
IF DGMT
IF $PIECE($GET(^DGMT(408.31,DGMT,2)),U,11)=1
QUIT
+11 ;* DG*688 - Check for Version 1 using 408.22 MT Ptr
IF DGMTIR
IF $PIECE($GET(^DGMT(408.31,DGMTIR,2)),U,11)=1
QUIT
+12 SET DGFLD=1.02
SET DGVAL=$PIECE(DGIN1,U,2)
+13 IF DGVAL]""
DO KILL
SET $PIECE(^DGMT(408.21,DGINI,1),U,2)=""
+14 QUIT
+15 ;
SP ;"Trigger" Cross-reference on the Amount Contributed to Spouse field
+1 ;(#.07) to delete net worth on file for a spouse
+2 NEW DFN,DGIN2,DGINI,DGLY,DGREL,DGVAL
+3 SET DGIR0=$GET(^DGMT(408.22,DA,0))
+4 SET DFN=+DGIR0
SET DGLY=+$GET(^DGMT(408.21,+$PIECE(DGIR0,U,2),0))
Begin DoDot:1
+5 NEW DA,X
+6 DO GETREL^DGMTU11(DFN,"S",DGLY,$SELECT($GET(DGMTI):DGMTI,1:""))
End DoDot:1
+7 SET DGINI=+$$IAI^DGMTU3(+$GET(DGREL("S")),DGLY)
+8 SET DGIN2=$GET(^DGMT(408.21,DGINI,2))
+9 FOR DGFLD=2.01:.01:2.05
SET DGVAL=$PIECE(DGIN2,U,(DGFLD-2)/.01)
IF DGVAL]""
Begin DoDot:1
+10 DO KILL
+11 SET $PIECE(^DGMT(408.21,DGINI,2),U,(DGFLD-2)/.01)=""
End DoDot:1
+12 QUIT
+13 ;
INC ;"Trigger" Cross-reference on the Child Had Income field (#.11) and
+1 ;Income Available To You field (#.12) to delete educational expenses
+2 ;on file for a child
+3 NEW DGINI
+4 SET DGINI=+$PIECE($GET(^DGMT(408.22,DA,0)),U,2)
+5 IF $PIECE($GET(^DGMT(408.21,DGINI,0)),U,14)]""
Begin DoDot:1
+6 NEW DGFLD,DGVAL
+7 IF $PIECE($GET(^DGMT(408.21,DGINI,1)),U,3)]""
SET DGVAL=$PIECE(^(1),U,3)
SET DGFLD=1.03
DO KILL
SET $PIECE(^DGMT(408.21,DGINI,1),U,3)=""
End DoDot:1
+8 QUIT
KILL ;Kill Cross-Reference
+1 NEW DA,DGIX,X
+2 SET DA=DGINI
SET X=DGVAL
SET DGIX=0
+3 FOR
SET DGIX=$ORDER(^DD(408.21,DGFLD,1,DGIX))
if 'DGIX
QUIT
XECUTE ^(DGIX,2)
SET X=DGVAL
+4 QUIT
+5 ;
MAR ;Input Transform check for the Married field (#.05)
+1 ;for an active spouse
+2 NEW DFN,DGIR0,DGLY,DGREL
+3 SET DGIR0=$GET(^DGMT(408.22,DA,0))
+4 SET DFN=+DGIR0
SET DGLY=+$GET(^DGMT(408.21,+$PIECE(DGIR0,U,2),0))
Begin DoDot:1
+5 NEW DA,X
+6 DO GETREL^DGMTU11(DFN,"S",DGLY,$SELECT($GET(DGMTI):DGMTI,1:""))
End DoDot:1
+7 IF $DATA(DGREL("S"))
WRITE !?5,"An active spouse exists. Married cannot be 'NO'.",!?5,"You have to use the 'Expand Dependent' action and inactive first."
KILL X
+8 QUIT
+9 ;
DEP ;Input Transform check for the Dependent Children field (#.08)
+1 ;for active children
+2 NEW DFN,DGDEP,DGIR0,DGLY,DGREL
+3 SET DGIR0=$GET(^DGMT(408.22,DA,0))
+4 SET DFN=+DGIR0
SET DGLY=+$GET(^DGMT(408.21,+$PIECE(DGIR0,U,2),0))
Begin DoDot:1
+5 NEW DA,X
+6 DO GETREL^DGMTU11(DFN,"C",DGLY,$SELECT($GET(DGMTI):DGMTI,1:""))
End DoDot:1
+7 IF $DATA(DGREL("C"))
WRITE !?5,"Active children exist. Dependent Children cannot be 'NO'."
KILL X
+8 QUIT
+9 ;
LIV ;Input Transform check for Lived With Patient field (#.06)
+1 NEW DGIR0,DGPRI
+2 SET DGIR0=$GET(^DGMT(408.22,DA,0))
SET DGPRI=+$PIECE($GET(^DGMT(408.21,+$PIECE(DGIR0,U,2),0)),U,2)
+3 IF $PIECE($GET(^DGPR(408.12,DGPRI,0)),U,2)=1
IF '$PIECE(DGIR0,U,5)
WRITE !?5,"This field does not need to be filled in unless the patient is married."
KILL X
+4 QUIT
+5 ;
AMT ;Input Transform check for Amount Contributed To Spouse field (#.07)
+1 NEW DGIR0,DGPRI
+2 SET DGIR0=$GET(^DGMT(408.22,DA,0))
SET DGPRI=+$PIECE($GET(^DGMT(408.21,+$PIECE(DGIR0,U,2),0)),U,2)
+3 IF $PIECE($GET(^DGPR(408.12,DGPRI,0)),U,2)=1
IF ('$PIECE(DGIR0,U,5)!($PIECE(DGIR0,U,6)'=0))
WRITE !?5,"This field does not need to be filled in unless the patient was married",!?5,"and did not live with his or her spouse."
KILL X
+4 QUIT
+5 ;
CON ;Input Transform check for Contributed To Support field (#.1)
+1 NEW DGIR0,DGPRI
+2 SET DGIR0=$GET(^DGMT(408.22,DA,0))
SET DGPRI=+$PIECE($GET(^DGMT(408.21,+$PIECE(DGIR0,U,2),0)),U,2)
+3 IF "^3^4^5^6^"[(U_$PIECE($GET(^DGPR(408.12,DGPRI,0)),U,2)_U)
IF $PIECE(DGIR0,U,6)'=0
WRITE !?5,"This field does not need to be filled in unless the child did not",!?5,"live with the patient."
KILL X
+4 QUIT
+5 ;
AVL ;Input Transform check for Income Available To You field (#.12)
+1 IF '$PIECE($GET(^DGMT(408.22,DA,0)),U,11)
WRITE !?5,"This field does not need to be filled in unless the child has income."
KILL X
+2 QUIT
+3 ;
NAM ;Output Transform for Individual Annual Income field (#.02)
+1 NEW DGIN0,DGPRI
+2 SET DGIN0=$GET(^DGMT(408.21,Y,0))
SET DGPRI=+$PIECE(DGIN0,U,2)
SET Y=+DGIN0
XECUTE ^DD("DD")
+3 SET Y=Y_" "_$$NAME^DGMTU1(DGPRI)
+4 QUIT
+5 ;
LIVHLP ;Help for Lived With Patient field (#.06)
+1 NEW DGIR0,DGPRI
+2 SET DGIR0=$GET(^DGMT(408.22,DA,0))
SET DGPRI=+$PIECE($GET(^DGMT(408.21,+$PIECE(DGIR0,U,2),0)),U,2)
+3 IF $PIECE($GET(^DGPR(408.12,DGPRI,0)),U,2)=1
WRITE !?5,"Enter in this field whether the veteran resided with his or her spouse",!?5,"last calendar year. If they were living apart because one was",!?5,"hospitalized or in a nursing home, enter 'YES'."
+4 IF "^3^4^5^6^"[(U_$PIECE($GET(^DGPR(408.12,DGPRI,0)),U,2)_U)
WRITE !?5,"Enter in this field whether the child resided with the veteran last",!?5,"calendar year."
+5 WRITE !
+6 QUIT
