- DGMTSC4 ;ALB/RMO/CAW,LBD,HM - Means Test Screen Net Worth ;11/7/03 1:44pm
- ;;5.3;Registration;**45,130,456,540,567,1014,1064**;Aug 13, 1993;Build 41
- ;
- ; 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
- ; DGMTACT Global variable, Means test action being perfomed, set when DGMTE, DGMTA, or DGMTEO is called
- ; Output -- None
- ;
- ;DG*5.3*540 - Skip displaying of calculated Means Test Status at the
- ; bottom of screen 4 when in VIEW mode.
- ;DG*5.3*567 - Allow bottom to show for all except SOURCE OF TEST[IVM
- ; for IVM display Source is IVM instead.
- ;
- EN ;Entry point for previous calendar year net worth screen
- I DGMTACT'="EDT"&(DGMTACT'="ADD")&(DGMTACT'="COM") D G EN^DGMTSCR ;DG*5.3*1014 check if entry point in screen was from edit, add, or complete a means test and skip screen 4
- .D DEP^DGMTSCU2,INC^DGMTSCU3 ;DG*5.3*1014 set variable for screen 4 display
- .N DGVET,DGSPD S (DGVET,DGSPD)=""
- .S DGVET(1)=$P($G(DGIN2("V")),U),DGVET(2)=$P($G(DGIN2("V")),U,3),DGVET(3)=$P($G(DGIN2("V")),U,4)
- .S DGSPD(1)=$P($G(DGIN2("S")),U),DGSPD(2)=$P($G(DGIN2("S")),U,3),DGSPD(3)=$P($G(DGIN2("S")),U,4)
- .S DGMTSCI=4 I DGVET(1)'=""!(DGVET(2)'="")!(DGVET(3)'="")!(DGSPD(1)'="")!(DGSPD(2)'="")!(DGSPD(3)'="") D HD^DGMTSCU
- .I DGVET(1)=""&(DGVET(2)="")&(DGVET(3)="") S DGSCR1=1
- .I DGSPD(1)=""&(DGSPD(2)="")&(DGSPD(3)="") S DGSCR1=1
- .I $$GETNAME^DGMTH(DGMTSCI)'="MT COPAY EXEMPT",DGVET(1)'=""!(DGVET(2)'="")!(DGVET(3)'="")!(DGSPD(1)'="")!(DGSPD(2)'="")!(DGSPD(3)'="") D DIS ;DG*5.3*1014 do screen 4 if not MT COPAY EXEMPT
- .I $$GETNAME^DGMTH(DGMTSCI)="MT COPAY EXEMPT"&(DGMTACT'="EDT")&(DGMTACT'="ADD")&(DGMTACT'="COM") D ;DG*5.3*1014 do screen 4 if not edit, add, or complete and status is MT COPAY EXEMPT
- ..I DGVET(1)'=""!(DGVET(2)'="")!(DGVET(3)'="")!(DGSPD(1)'="")!(DGSPD(2)'="")!(DGSPD(3)'="") D DIS ;if financial data exists for screen 4 display
- .S DGRNG="1-3"
- .I $G(DGSCR1),DGSCR1=1 D MTMSG ;DG*5.3*1014 display MT status message
- I DGMTACT="EDT"!(DGMTACT="ADD")!(DGMTACT="COM") S DGRNG="1-3",DGMTSCI=4 D FEED^DGMTSCR,EN1^DGMTSCR Q ;DG*5.3*1014 do not rewrite bottom of screen
- ;
- EN1 ;Entry point for read processor return
- D ALL^DGMTU21(DFN,"S",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
- 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 ?46,"Spouse" W ?73,"Total"
- W !?31,"-----------------------------------------------"
- D HIGH^DGMTSCU1(1,DGMTACT),FLD(.DGIN2,1,"Cash, Amts in Bank Accts")
- D HIGH^DGMTSCU1(2,DGMTACT),FLD(.DGIN2,2,"Stocks and Bonds")
- D HIGH^DGMTSCU1(3,DGMTACT),FLD(.DGIN2,3,"Real Property")
- D HIGH^DGMTSCU1(4,DGMTACT),FLD(.DGIN2,4,"Other Property or Assets")
- D HIGH^DGMTSCU1(5,DGMTACT),FLD(.DGIN2,5,"Debts")
- 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
- ;
- ;DG*5.3*540
- ;DG*5.3*567
- I DGMTACT="VEW",DGMTI,$$GET1^DIQ(408.31,DGMTI,.23)["IVM" D G DISQ
- . W !!!!!!!!,"Source of Test is IVM"
- K DGSCR1 ;DG*5.3*1014 kill variable to not display repeating info
- MTMSG ;DG*5.3*1014 only display for view a past means test
- I DGMTACT="VEW" D
- .D DEP^DGMTSCU2,INC^DGMTSCU3
- .S DGCAT=$P(^DGMT(408.31,DGMTI,0),"^",3),DGCAT=$P(^DG(408.32,DGCAT,0),"^",2) D STA^DGMTSCU2 S DGCNT=1
- .W !!!!!! I DGMTYPT=1 W "Income of ",$J($$AMT^DGMTSCU1(DGINT-DGDET),12) W " ",$$GETNAME^DGMTH(DGMTS)
- .;jam; DG*5.3*1064
- .I $$INDSTATUS^DGENELA2(DFN) D
- . . D BLD^DIALOG(261134,"","","","F")
- . . D MSG^DIALOG("WM","","","")
- .;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:DGCNT<10 " "
- W " ",$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("D")):$J($$AMT^DGMTSCU1($P(DGIN("D"),"^",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
- 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 DA=DGINI,DIE="^DGMT(408.21,",DR="[DGMT ENTER/EDIT NET WORTH]" 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTSC4 6090 printed Jan 18, 2025@03:46:04 Page 2
- DGMTSC4 ;ALB/RMO/CAW,LBD,HM - Means Test Screen Net Worth ;11/7/03 1:44pm
- +1 ;;5.3;Registration;**45,130,456,540,567,1014,1064**;Aug 13, 1993;Build 41
- +2 ;
- +3 ; Input -- DFN Patient IEN
- +4 ; DGMTDT Date of Test
- +5 ; DGMTYPT Type of Test 1=MT 2=COPAY
- +6 ; DGMTPAR Annual Means Test Parameter Array
- +7 ; DGVINI Veteran Individual Annual Income IEN
- +8 ; DGVIRI Veteran Income Relation IEN
- +9 ; DGVPRI Veteran Patient Relation IEN
- +10 ; DGMTNWC Net Worth Calculation flag
- +11 ; DGMTACT Global variable, Means test action being perfomed, set when DGMTE, DGMTA, or DGMTEO is called
- +12 ; Output -- None
- +13 ;
- +14 ;DG*5.3*540 - Skip displaying of calculated Means Test Status at the
- +15 ; bottom of screen 4 when in VIEW mode.
- +16 ;DG*5.3*567 - Allow bottom to show for all except SOURCE OF TEST[IVM
- +17 ; for IVM display Source is IVM instead.
- +18 ;
- EN ;Entry point for previous calendar year net worth screen
- +1 ;DG*5.3*1014 check if entry point in screen was from edit, add, or complete a means test and skip screen 4
- IF DGMTACT'="EDT"&(DGMTACT'="ADD")&(DGMTACT'="COM")
- Begin DoDot:1
- +2 ;DG*5.3*1014 set variable for screen 4 display
- DO DEP^DGMTSCU2
- DO INC^DGMTSCU3
- +3 NEW DGVET,DGSPD
- SET (DGVET,DGSPD)=""
- +4 SET DGVET(1)=$PIECE($GET(DGIN2("V")),U)
- SET DGVET(2)=$PIECE($GET(DGIN2("V")),U,3)
- SET DGVET(3)=$PIECE($GET(DGIN2("V")),U,4)
- +5 SET DGSPD(1)=$PIECE($GET(DGIN2("S")),U)
- SET DGSPD(2)=$PIECE($GET(DGIN2("S")),U,3)
- SET DGSPD(3)=$PIECE($GET(DGIN2("S")),U,4)
- +6 SET DGMTSCI=4
- IF DGVET(1)'=""!(DGVET(2)'="")!(DGVET(3)'="")!(DGSPD(1)'="")!(DGSPD(2)'="")!(DGSPD(3)'="")
- DO HD^DGMTSCU
- +7 IF DGVET(1)=""&(DGVET(2)="")&(DGVET(3)="")
- SET DGSCR1=1
- +8 IF DGSPD(1)=""&(DGSPD(2)="")&(DGSPD(3)="")
- SET DGSCR1=1
- +9 ;DG*5.3*1014 do screen 4 if not MT COPAY EXEMPT
- IF $$GETNAME^DGMTH(DGMTSCI)'="MT COPAY EXEMPT"
- IF DGVET(1)'=""!(DGVET(2)'="")!(DGVET(3)'="")!(DGSPD(1)'="")!(DGSPD(2)'="")!(DGSPD(3)'="")
- DO DIS
- +10 ;DG*5.3*1014 do screen 4 if not edit, add, or complete and status is MT COPAY EXEMPT
- IF $$GETNAME^DGMTH(DGMTSCI)="MT COPAY EXEMPT"&(DGMTACT'="EDT")&(DGMTACT'="ADD")&(DGMTACT'="COM")
- Begin DoDot:2
- +11 ;if financial data exists for screen 4 display
- IF DGVET(1)'=""!(DGVET(2)'="")!(DGVET(3)'="")!(DGSPD(1)'="")!(DGSPD(2)'="")!(DGSPD(3)'="")
- DO DIS
- End DoDot:2
- +12 SET DGRNG="1-3"
- +13 ;DG*5.3*1014 display MT status message
- IF $GET(DGSCR1)
- IF DGSCR1=1
- DO MTMSG
- End DoDot:1
- GOTO EN^DGMTSCR
- +14 ;DG*5.3*1014 do not rewrite bottom of screen
- IF DGMTACT="EDT"!(DGMTACT="ADD")!(DGMTACT="COM")
- SET DGRNG="1-3"
- SET DGMTSCI=4
- DO FEED^DGMTSCR
- DO EN1^DGMTSCR
- QUIT
- +15 ;
- EN1 ;Entry point for read processor return
- +1 DO ALL^DGMTU21(DFN,"S",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
- 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 ?46,"Spouse"
- WRITE ?73,"Total"
- +6 WRITE !?31,"-----------------------------------------------"
- +7 DO HIGH^DGMTSCU1(1,DGMTACT)
- DO FLD(.DGIN2,1,"Cash, Amts in Bank Accts")
- +8 DO HIGH^DGMTSCU1(2,DGMTACT)
- DO FLD(.DGIN2,2,"Stocks and Bonds")
- +9 DO HIGH^DGMTSCU1(3,DGMTACT)
- DO FLD(.DGIN2,3,"Real Property")
- +10 DO HIGH^DGMTSCU1(4,DGMTACT)
- DO FLD(.DGIN2,4,"Other Property or Assets")
- +11 DO HIGH^DGMTSCU1(5,DGMTACT)
- DO FLD(.DGIN2,5,"Debts")
- +12 WRITE !?51,"Total -->",?66,$JUSTIFY($$AMT^DGMTSCU1(DGNWT),12)
- +13 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
- +14 ;
- +15 ;DG*5.3*540
- +16 ;DG*5.3*567
- +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 ;DG*5.3*1014 kill variable to not display repeating info
- KILL DGSCR1
- MTMSG ;DG*5.3*1014 only display for view a past means test
- +1 IF DGMTACT="VEW"
- Begin DoDot:1
- +2 DO DEP^DGMTSCU2
- DO INC^DGMTSCU3
- +3 SET DGCAT=$PIECE(^DGMT(408.31,DGMTI,0),"^",3)
- SET DGCAT=$PIECE(^DG(408.32,DGCAT,0),"^",2)
- DO STA^DGMTSCU2
- SET DGCNT=1
- +4 WRITE !!!!!!
- IF DGMTYPT=1
- WRITE "Income of ",$JUSTIFY($$AMT^DGMTSCU1(DGINT-DGDET),12)
- WRITE " ",$$GETNAME^DGMTH(DGMTS)
- +5 ;jam; DG*5.3*1064
- +6 IF $$INDSTATUS^DGENELA2(DFN)
- Begin DoDot:2
- +7 DO BLD^DIALOG(261134,"","","","F")
- +8 DO MSG^DIALOG("WM","","","")
- End DoDot:2
- +9 ;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."
- +10 ;I DGTYC="M",'DGNWTF W " requires property information."
- +11 ;I DGMTYPT=2,'DGNWTF,DGCAT="E" W "Requires property information."
- End DoDot:1
- 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
- +8 ; total)
- +9 ;
- +10 NEW DGTOT,I
- +11 IF '$DATA(DGBL)
- SET $PIECE(DGBL," ",26)=""
- +12 if DGCNT<10
- WRITE " "
- +13 WRITE " ",$EXTRACT(DGTXT_DGBL,1,26)
- +14 WRITE $JUSTIFY($$AMT^DGMTSCU1($PIECE(DGIN("V"),"^",DGPCE)),10)
- +15 WRITE " ",$SELECT($DATA(DGIN("S")):$JUSTIFY($$AMT^DGMTSCU1($PIECE(DGIN("S"),"^",DGPCE)),10),1:$EXTRACT(DGBL,1,10))
- +16 WRITE " ",$SELECT($DATA(DGIN("D")):$JUSTIFY($$AMT^DGMTSCU1($PIECE(DGIN("D"),"^",DGPCE)),11),1:$EXTRACT(DGBL,1,11))
- +17 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)
- +18 WRITE " ",$JUSTIFY($$AMT^DGMTSCU1(DGTOT),12)
- +19 SET DGCNT=DGCNT+1
- +20 QUIT
- +21 ;
- EDT ;Edit net worth fields
- +1 NEW DA,DGERR,DGFIN,DGINI,DGIN2,DGIRI,DIE,DR
- +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 DA=DGINI
- SET DIE="^DGMT(408.21,"
- SET DR="[DGMT ENTER/EDIT NET WORTH]"
- DO ^DIE
- if '$DATA(DGFIN)
- SET DGMTOUT=1
- +6 IF DGIN2'=$GET(^DGMT(408.21,DGINI,2))
- SET DR="103////^S X=DUZ;104///^S X=""NOW"""
- DO ^DIE
- EDTQ QUIT