- 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
