DGMTSC4V ;ALB/AMA - Means Test Screen Net Worth For MT Version 1
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
;Copied from DGMTSC4
;
; Input -- DFN Patient IEN
; DGMTDT Date of Test
; DGMTYPT Type of Test 1=MT 2=COPAY
; DGMTPAR Annual Means Test Parameter Array
; DGVINI Veteran Individual Annual Income IEN
; DGVIRI Veteran Income Relation IEN
; DGVPRI Veteran Patient Relation IEN
; DGMTNWC Net Worth Calculation flag
; Output -- None
;
EN ;Entry point for previous calendar year net worth screen
S DGMTSCI=4 D HD^DGMTSCU
D DIS
S DGRNG="1-3" G EN^DGMTSCR
;
EN1 ;Entry point for read processor return
D ALL^DGMTU21(DFN,"CS",DGMTDT,"IPR",$S($G(DGMTI):DGMTI,1:""))
I DGX!($G(DGSELTY)["V") S DGPRI=DGVPRI,DGPRTY="V" D EDT
I '$G(DGMTOUT)&($G(DGSEL)["S")&(DGX!($G(DGSELTY)["S")) S DGPRI=+DGREL("S"),DGPRTY="S" D EDT
;*Patch DG*5.3*688
I '$G(DGMTOUT)&($G(DGSEL)["C")&(DGX!($G(DGSELTY)["C")) S DGPRTY="C",DGCNT=0 F S DGCNT=$O(DGREL("C",DGCNT)) Q:'DGCNT!($G(DGMTOUT)) D
.D CHK^DGMTSCU2 I Y S DGPRI=+DGREL("C",DGCNT) D EDT
Q K DGCNT,DGDEP,DGDR,DGMTOUT,DGPRI,DGPRTY,DGREL,DGSEL,DGSELTY,DGX,DGY,DTOUT,DUOUT,Y
G EN
;
DIS ;Display net worth
N DGCAT,DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGMTS,DGNC,DGND,DGNWT,DGNWTF,DGSP,DGTYC,DGTHA,DGTHB,DGTHG,DGVIR0,DGCNT
D SET^DGMTSCU2 S DGCNT=1
I DGMTYPT=1 W !,"Income Thresholds: " W:$D(DGTHA) "MT Threshold: ",$$AMT^DGMTSCU1(DGTHA) W:$D(DGTHG) ?53,"GMT Threshold: ",$$AMT^DGMTSCU1(DGTHG)
W ! W:$D(DGMTPAR("PREV")) "*Previous Years Thresholds*"
W ?34,"Veteran" W:DGSP ?47,"Spouse" W:DGDC ?57,"Children" W ?73,"Total"
W !?31,"-----------------------------------------------"
D HIGH^DGMTSCU1(1,DGMTACT) W " Cash, Amts in Bank Accts"
D FLD(.DGIN2,1,"(CDs,IRAs,Stocks,Bonds):")
D HIGH^DGMTSCU1(2,DGMTACT) W " Land,Bldgs Less Mortgage,"
D FLD(.DGIN2,3,"Liens (Not Primary Home):")
D HIGH^DGMTSCU1(3,DGMTACT) W " Other Prop.(Farm,Bus.) Or"
W !?5,"Assets (Art,Collectibles)"
D FLD(.DGIN2,4,"Less Amount Owed:")
W !?51,"Total -->",?66,$J($$AMT^DGMTSCU1(DGNWT),12)
I DGMTYPT=1,DGMTACT="VEW",$P($G(DGMT0),"^",14) W !!!!!!,"Declines to give income information makes a MT COPAY REQUIRED status." G DISQ
;
I DGMTACT="VEW",DGMTI,$$GET1^DIQ(408.31,DGMTI,.23)["IVM" D G DISQ
. W !!!!!!,"Source of Test is IVM"
W !!!!!! I DGMTYPT=1 W "Income of ",$J($$AMT^DGMTSCU1(DGINT-DGDET),12) W " ",$$GETNAME^DGMTH(DGMTS)
I DGMTYPT=1,DGTYC="M",(DGNWT-DGDET)+$S($G(DGMTNWC):0,1:DGINT)'<$P(DGMTPAR,"^",8) W !,?3,"with property of ",$J($$AMT^DGMTSCU1(DGNWT),12)," makes a ",$S(DGTHG>DGTHA:"G",1:""),"MT COPAY REQUIRED status."
I DGTYC="M",'DGNWTF W " requires property information."
I DGMTYPT=2,'DGNWTF,DGCAT="E" W "Requires property information."
DISQ Q
;
FLD(DGIN,DGPCE,DGTXT) ;Display income fields
;
; Input -- DGIN as Individual Annual Income 0 node for vet,
; spouse, and dependents
; DGRPCE as piece position wanted
; DGTXT as income description
;
; Also keeps running total if DGGTOT is defined (grand total)
;
N DGTOT,I
I '$D(DGBL) S $P(DGBL," ",26)=""
W !?5,$E(DGTXT_DGBL,1,26)
W $J($$AMT^DGMTSCU1($P(DGIN("V"),"^",DGPCE)),10)
W " ",$S($D(DGIN("S")):$J($$AMT^DGMTSCU1($P(DGIN("S"),"^",DGPCE)),10),1:$E(DGBL,1,10))
W " ",$S($D(DGIN("C")):$J($$AMT^DGMTSCU1($P(DGIN("C"),"^",DGPCE)),11),1:$E(DGBL,1,11))
S DGTOT="",I="" F S I=$O(DGIN(I)) Q:I="" I $P(DGIN(I),"^",DGPCE)]"" S DGTOT=DGTOT+$P(DGIN(I),"^",DGPCE)
W " ",$J($$AMT^DGMTSCU1(DGTOT),12)
S DGCNT=DGCNT+1
Q
;
EDT ;Edit net worth fields
N DA,DGERR,DGFIN,DGINI,DGIN2,DGIRI,DIE,DR,DGMTVR
D GETIENS^DGMTU2(DFN,DGPRI,DGMTDT) G EDTQ:DGERR
I $G(DGSEL)]"" W !!,"NAME: ",$$NAME^DGMTU1(DGPRI)
S DGIN2=$G(^DGMT(408.21,DGINI,2))
S DGMTVR=$P($G(^DGMT(408.31,$G(DGMTI),2)),"^",11)
S DR="[DGMT V1 ENTER/EDIT NET WORTH]"
S DA=DGINI,DIE="^DGMT(408.21," D ^DIE S:'$D(DGFIN) DGMTOUT=1
I DGIN2'=$G(^DGMT(408.21,DGINI,2)) S DR="103////^S X=DUZ;104///^S X=""NOW""" D ^DIE
EDTQ Q
DGMTSC4V ;ALB/AMA - Means Test Screen Net Worth For MT Version 1
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
+2 ;Copied from DGMTSC4
+3 ;
+4 ; Input -- DFN Patient IEN
+5 ; DGMTDT Date of Test
+6 ; DGMTYPT Type of Test 1=MT 2=COPAY
+7 ; DGMTPAR Annual Means Test Parameter Array
+8 ; DGVINI Veteran Individual Annual Income IEN
+9 ; DGVIRI Veteran Income Relation IEN
+10 ; DGVPRI Veteran Patient Relation IEN
+11 ; DGMTNWC Net Worth Calculation flag
+12 ; Output -- None
+13 ;
EN ;Entry point for previous calendar year net worth screen
+1 SET DGMTSCI=4
DO HD^DGMTSCU
+2 DO DIS
+3 SET DGRNG="1-3"
GOTO EN^DGMTSCR
+4 ;
EN1 ;Entry point for read processor return
+1 DO ALL^DGMTU21(DFN,"CS",DGMTDT,"IPR",$SELECT($GET(DGMTI):DGMTI,1:""))
+2 IF DGX!($GET(DGSELTY)["V")
SET DGPRI=DGVPRI
SET DGPRTY="V"
DO EDT
+3 IF '$GET(DGMTOUT)&($GET(DGSEL)["S")&(DGX!($GET(DGSELTY)["S"))
SET DGPRI=+DGREL("S")
SET DGPRTY="S"
DO EDT
+4 ;*Patch DG*5.3*688
+5 IF '$GET(DGMTOUT)&($GET(DGSEL)["C")&(DGX!($GET(DGSELTY)["C"))
SET DGPRTY="C"
SET DGCNT=0
FOR
SET DGCNT=$ORDER(DGREL("C",DGCNT))
IF 'DGCNT!($GET(DGMTOUT))
QUIT
Begin DoDot:1
+6 DO CHK^DGMTSCU2
IF Y
SET DGPRI=+DGREL("C",DGCNT)
DO EDT
End DoDot:1
Q KILL DGCNT,DGDEP,DGDR,DGMTOUT,DGPRI,DGPRTY,DGREL,DGSEL,DGSELTY,DGX,DGY,DTOUT,DUOUT,Y
+1 GOTO EN
+2 ;
DIS ;Display net worth
+1 NEW DGCAT,DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGMTS,DGNC,DGND,DGNWT,DGNWTF,DGSP,DGTYC,DGTHA,DGTHB,DGTHG,DGVIR0,DGCNT
+2 DO SET^DGMTSCU2
SET DGCNT=1
+3 IF DGMTYPT=1
WRITE !,"Income Thresholds: "
IF $DATA(DGTHA)
WRITE "MT Threshold: ",$$AMT^DGMTSCU1(DGTHA)
IF $DATA(DGTHG)
WRITE ?53,"GMT Threshold: ",$$AMT^DGMTSCU1(DGTHG)
+4 WRITE !
IF $DATA(DGMTPAR("PREV"))
WRITE "*Previous Years Thresholds*"
+5 WRITE ?34,"Veteran"
IF DGSP
WRITE ?47,"Spouse"
IF DGDC
WRITE ?57,"Children"
WRITE ?73,"Total"
+6 WRITE !?31,"-----------------------------------------------"
+7 DO HIGH^DGMTSCU1(1,DGMTACT)
WRITE " Cash, Amts in Bank Accts"
+8 DO FLD(.DGIN2,1,"(CDs,IRAs,Stocks,Bonds):")
+9 DO HIGH^DGMTSCU1(2,DGMTACT)
WRITE " Land,Bldgs Less Mortgage,"
+10 DO FLD(.DGIN2,3,"Liens (Not Primary Home):")
+11 DO HIGH^DGMTSCU1(3,DGMTACT)
WRITE " Other Prop.(Farm,Bus.) Or"
+12 WRITE !?5,"Assets (Art,Collectibles)"
+13 DO FLD(.DGIN2,4,"Less Amount Owed:")
+14 WRITE !?51,"Total -->",?66,$JUSTIFY($$AMT^DGMTSCU1(DGNWT),12)
+15 IF DGMTYPT=1
IF DGMTACT="VEW"
IF $PIECE($GET(DGMT0),"^",14)
WRITE !!!!!!,"Declines to give income information makes a MT COPAY REQUIRED status."
GOTO DISQ
+16 ;
+17 IF DGMTACT="VEW"
IF DGMTI
IF $$GET1^DIQ(408.31,DGMTI,.23)["IVM"
Begin DoDot:1
+18 WRITE !!!!!!,"Source of Test is IVM"
End DoDot:1
GOTO DISQ
+19 WRITE !!!!!!
IF DGMTYPT=1
WRITE "Income of ",$JUSTIFY($$AMT^DGMTSCU1(DGINT-DGDET),12)
WRITE " ",$$GETNAME^DGMTH(DGMTS)
+20 IF DGMTYPT=1
IF DGTYC="M"
IF (DGNWT-DGDET)+$SELECT($GET(DGMTNWC):0,1:DGINT)'<$PIECE(DGMTPAR,"^",8)
WRITE !,?3,"with property of ",$JUSTIFY($$AMT^DGMTSCU1(DGNWT),12)," makes a ",$SELECT(DGTHG>DGTHA:"G",1:""),"MT COPAY REQUIRED status."
+21 IF DGTYC="M"
IF 'DGNWTF
WRITE " requires property information."
+22 IF DGMTYPT=2
IF 'DGNWTF
IF DGCAT="E"
WRITE "Requires property information."
DISQ QUIT
+1 ;
FLD(DGIN,DGPCE,DGTXT) ;Display income fields
+1 ;
+2 ; Input -- DGIN as Individual Annual Income 0 node for vet,
+3 ; spouse, and dependents
+4 ; DGRPCE as piece position wanted
+5 ; DGTXT as income description
+6 ;
+7 ; Also keeps running total if DGGTOT is defined (grand total)
+8 ;
+9 NEW DGTOT,I
+10 IF '$DATA(DGBL)
SET $PIECE(DGBL," ",26)=""
+11 WRITE !?5,$EXTRACT(DGTXT_DGBL,1,26)
+12 WRITE $JUSTIFY($$AMT^DGMTSCU1($PIECE(DGIN("V"),"^",DGPCE)),10)
+13 WRITE " ",$SELECT($DATA(DGIN("S")):$JUSTIFY($$AMT^DGMTSCU1($PIECE(DGIN("S"),"^",DGPCE)),10),1:$EXTRACT(DGBL,1,10))
+14 WRITE " ",$SELECT($DATA(DGIN("C")):$JUSTIFY($$AMT^DGMTSCU1($PIECE(DGIN("C"),"^",DGPCE)),11),1:$EXTRACT(DGBL,1,11))
+15 SET DGTOT=""
SET I=""
FOR
SET I=$ORDER(DGIN(I))
IF I=""
QUIT
IF $PIECE(DGIN(I),"^",DGPCE)]""
SET DGTOT=DGTOT+$PIECE(DGIN(I),"^",DGPCE)
+16 WRITE " ",$JUSTIFY($$AMT^DGMTSCU1(DGTOT),12)
+17 SET DGCNT=DGCNT+1
+18 QUIT
+19 ;
EDT ;Edit net worth fields
+1 NEW DA,DGERR,DGFIN,DGINI,DGIN2,DGIRI,DIE,DR,DGMTVR
+2 DO GETIENS^DGMTU2(DFN,DGPRI,DGMTDT)
IF DGERR
GOTO EDTQ
+3 IF $GET(DGSEL)]""
WRITE !!,"NAME: ",$$NAME^DGMTU1(DGPRI)
+4 SET DGIN2=$GET(^DGMT(408.21,DGINI,2))
+5 SET DGMTVR=$PIECE($GET(^DGMT(408.31,$GET(DGMTI),2)),"^",11)
+6 SET DR="[DGMT V1 ENTER/EDIT NET WORTH]"
+7 SET DA=DGINI
SET DIE="^DGMT(408.21,"
DO ^DIE
IF '$DATA(DGFIN)
SET DGMTOUT=1
+8 IF DGIN2'=$GET(^DGMT(408.21,DGINI,2))
SET DR="103////^S X=DUZ;104///^S X=""NOW"""
DO ^DIE
EDTQ QUIT
