DGMTSCC ;ALB/RMO,CAW,LBD,EG,LMD,HM,JAM - Means Test Screen Completion ;03/24/2006
;;5.3;Registration;**33,45,130,438,332,433,462,456,610,624,611,890,1014,1064**;Aug 13, 1993;Build 41
;
; Input -- DFN Patient IEN
; DGMTACT Means Test Action
; DGMTDT Date of Test
; DGMTYPT Type of Test 1=MT 2=COPAY
; DGMTPAR Annual Means Test Parameters
; DGVINI Veteran Individual Annual Income IEN
; DGVIRI Veteran Income Relation IEN
; DGVPRI Veteran Patient Relation IEN
; DGMTNWC Net Worth Calculation flag
; Output -- DGERR 1=INCOMPLETE and 0=COMPLETE
;
EN N DGCAT,DGCOMF,DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGMTS,DGNC,DGND,DGNWT,DGNWTF,DGREF1,DGSP,DGTYC,DGTHA,DGTHB,DGVIR0,DGCOPS,DGCOST,DGTHG
S DGERR=0
I DGMTACT="ADD" D COM I 'Y!($D(DTOUT))!($D(DUOUT)) G Q
S DGCOMF=1 D DEP^DGMTSCU2,INC^DGMTSCU3
;if ANSPFIN="Y" user already answered to provide financial information (module DISC^DGMTSC)
I $G(ANSPFIN)="Y",$D(DGREF) D
. S (DGINTF,DGNWTF)=""
. W !,"DECLINES TO GIVE INCOME INFORMATION: YES"
. S DGREF1=""
. Q
I ($G(DGINTF)=0),($G(DGNWTF)=0) S DGREF1="" D REF G Q:$D(DTOUT)!($D(DUOUT))
D CAT^DGMTSCU2,STA^DGMTSCU2
;don't try to run validation checks if declining to provide financial information
I '$D(DGREF) D CHK I DGERR W !?3,*7,$S(DGMTYPT=1:"Means",1:"Copay")_" test cannot be completed." G Q
I DGMTYPT=1,DGTYC="M",(DGNWT-DGDET)+$S(DGMTNWC:0,1:DGINT)'<$P(DGMTPAR,"^",8) D ADJ G Q:$D(DTOUT)!($D(DUOUT))
I DGMTYPT=2,DGCAT="P" D ADJ G Q:$D(DTOUT)!($D(DUOUT))
S DA=DGMTI,DIE="^DGMT(408.31,",DIE("NO^")="",DR="[DGMT ENTER/EDIT COMPLETION]" D ^DIE K DA,DIE,DR I '$D(DGFIN) S DGERR=1 G Q
I DGMTACT="EDT",DGMTDT>DT D
. N DATA S (DATA(.01),DATA(.07))=DT,DATA(2)=1 I $$UPD^DGENDBS(408.31,DGMTI,.DATA)
W:DGMTYPT=1 !?3,"...means test status is ",$P($$MTS^DGMTU(DFN,DGMTS),"^"),"..."
W:DGMTYPT=2 !?3,"...copay test status is ",$S(DGCAT="E":"EXEMPT",DGCAT="M":"NON-EXEMPT",DGCAT="P":"PENDING ADJUDICATION",1:"INCOMPLETE"),"..."
;jam; DG*5.3*1064
I $$INDSTATUS^DGENELA2(DFN) D
. D BLD^DIALOG(261134,"","","","F")
. D MSG^DIALOG("WM","","","")
;
D PRT
;
Q K DGFIN,DTOUT,DUOUT,Y
Q
;
COM ;Check if user wants to complete the means test
N DIR
S DIR("A")="Do you wish to complete the "_$S(DGMTYPT=1:"means",1:"copay exemption")_" test"
S DIR("B")="YES",DIR(0)="Y" D ^DIR
; The following was added for LTC Copay Phase II (DG*5.3*433)
I DGMTYPT=4,'Y D
. W !,"NOTE: If you do not complete the LTC copay exemption test, the incomplete test",!?6,"will be deleted."
. S DIR("A")="Do you wish to complete the copay exemption test"
. S DIR("B")="YES",DIR(0)="Y" D ^DIR
Q
;
REF ;Check if patient declines to provide income information
;ANSPFIN Y - user already answer this question (see program DGMTSC)
N DIR,Y,U
S U="^"
S DIR("A")="DECLINES TO GIVE INCOME INFORMATION"
I $P($G(^DGMT(408.31,DGMTI,0)),"^",14)]"" S DIR("B")=$$YN^DGMTSCU1($P(^(0),"^",14))
I '$D(DIR("B")),$G(ANSPFIN)'="Y" S DIR("B")="NO"
;user answered Y to provide income initially, but didn't provide income information
I $G(ANSPFIN)="Y" S DIR("B")="YES"
I $G(DGINTF)=0,$G(DGNWTF)=0 S DIR("B")="YES"
S DIR(0)="408.31,.14" D ^DIR K DIR G REFQ:$D(DTOUT)!($D(DUOUT))
S:Y DGREF="" Q:'$D(DGREF)!($D(DGREF1))!(DGMTYPT'=1) S DGCAT="C" D STA^DGMTSCU2
S ANSPFIN="Y"
REFQ Q
;
CHK ;Check if means test can be completed
N DGA,DGD,DGDEP,DGREL,DGL,DGM,I
D GETREL^DGMTU11(DFN,"CS",$$LYR^DGMTSCU1(DGMTDT),$S($G(DGMTI):DGMTI,1:""))
S DGM=$P(DGVIR0,"^",5),DGL=$P(DGVIR0,"^",6),DGA=$P(DGVIR0,"^",20),DGD=$P(DGVIR0,"^",8) ;DG*5.3*890
I DGM']""!(DGM&(DGL']""))!(DGM&('DGL)&(DGA']"")) W !?3,"Marital section must be completed." S DGERR=1
I DGM,'$D(DGREL("S")),'$D(DGREF) W !?3,"Married is 'YES'. An active spouse for this means test does not exist." S DGERR=1
I 'DGM,$D(DGREL("S")) W !?3,"An active spouse exists for this means test. Married should be 'YES'." S DGERR=1
I DGD']"" W !?3,"Dependent Children section must be completed." S DGERR=1
I DGD,'$D(DGREL("C")) W !?3,"Dependent Children is 'YES'. No active children exist." S DGERR=1
I 'DGD,$D(DGREL("C")) W !?3,"Active children exist. Dependent Children should be 'YES'." S DGERR=1
I DGMTYPT=1,'$D(DGREF),DGTYC="M",'DGNWTF D
.;DG*5.3*1014 check if entry point in screen was from edit, add, or complete a means test
.I DGMTACT'="EDT"&(DGMTACT'="ADD")&(DGMTACT'="COM") W !?3,"A status of ",$$GETNAME^DGMTH(DGMTS)," requires property information." S DGERR=1
I DGMTYPT=2,'DGNWTF,DGCAT="E",$$ASKNW^DGMTCOU W !?3,"Patient is in an 'EXEMPT' status and requires property information." S DGERR=1
I DGDET>DGINT W !?3,"Patient's deductible expenses cannot exceed income." S DGERR=1
Q:$G(DGERR)
N CNT,ACT,DGDEP,FLAG,DGINCP
D INIT^DGDEP S CNT=0 D
. F S CNT=$O(DGDEP(CNT)) Q:'CNT I $P(DGDEP(CNT),U,2)="SPOUSE" D Q:$G(DGERR)
. . D GETIENS^DGMTU2(DFN,$P(DGDEP(CNT),U,20),DGMTDT)
. . S DGINCP=$G(^DGMT(408.22,+DGIRI,"MT")) S:DGINCP FLAG=$G(FLAG)+1
. . I $G(FLAG)>1 W !?3,"Patient has more than one spouse for this means test." S DGERR=1
Q
;
ADJ ;Adjudicate the means test
I DGMTACT="EDT"!(DGMTACT="ADD")!(DGMTACT="COM") Q ;DG*5.3*1014
N DIR,Y
S DIR("?",1)="Since assets exceed the threshold, the "_$S(DGMTYPT=1:"means",1:"copay")_" test can"
S DIR("?",2)="be sent to adjudication. If the "_$S(DGMTYPT=1:"means",1:"copay")_" test is not"
S DIR("?")="adjudicated, the patient will be placed in "_$S(DGMTYPT=1&(DGTHG>DGTHA):"GMT Copay Required",DGMTYPT=1:"MT Copay Required",1:"Non-exempt")_" status."
S DIR("A")="Do you wish to send this case to adjudication"
S DIR("B")="YES",DIR(0)="Y" D ^DIR G ADJQ:$D(DTOUT)!($D(DUOUT))
S DGCAT=$S(Y:"P",DGMTYPT=1&(DGTHG>DGTHA):"G",DGMTYPT=1:"C",1:"N") D STA^DGMTSCU2
ADJQ Q
;
;DG*5.3*624 - REMOVE 10-10F AND REPLACE WITH 10-10EZ/EZR
PRT ;Print the 10-10EZR or 10-10EZ
N EZFLAG
I $D(DGFINOP) DO
.W !!,"Options for printing financial assessment information will follow."
.W !,"Generally, you should answer 'YES' to 'PRINT 10-10EZR?' after updating"
.W !,"patient demographic or financial information. Answer 'YES' to 'PRINT"
.W !,"10-10EZ?' after entering new patient demographic and financial information."
S EZFLAG=$$SEL1010^DG1010P("EZR/EZ")
Q:(EZFLAG=-1)
D QUE
;
PRTQ Q
;
;DG*5.3*624 - REMOVE 10-10F AND REPLACE WITH 10-10EZ/EZR
QUE ;
N X
I $G(EZFLAG)="EZ" S X=$$ENEZ^EASEZPDG(DFN,DGMTI)
I $G(EZFLAG)="EZR" S X=$$ENEZR^EASEZPDG(DFN,DGMTI)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTSCC 6598 printed Apr 09, 2024@22:01:08 Page 2
DGMTSCC ;ALB/RMO,CAW,LBD,EG,LMD,HM,JAM - Means Test Screen Completion ;03/24/2006
+1 ;;5.3;Registration;**33,45,130,438,332,433,462,456,610,624,611,890,1014,1064**;Aug 13, 1993;Build 41
+2 ;
+3 ; Input -- DFN Patient IEN
+4 ; DGMTACT Means Test Action
+5 ; DGMTDT Date of Test
+6 ; DGMTYPT Type of Test 1=MT 2=COPAY
+7 ; DGMTPAR Annual Means Test Parameters
+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 -- DGERR 1=INCOMPLETE and 0=COMPLETE
+13 ;
EN NEW DGCAT,DGCOMF,DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGMTS,DGNC,DGND,DGNWT,DGNWTF,DGREF1,DGSP,DGTYC,DGTHA,DGTHB,DGVIR0,DGCOPS,DGCOST,DGTHG
+1 SET DGERR=0
+2 IF DGMTACT="ADD"
DO COM
IF 'Y!($DATA(DTOUT))!($DATA(DUOUT))
GOTO Q
+3 SET DGCOMF=1
DO DEP^DGMTSCU2
DO INC^DGMTSCU3
+4 ;if ANSPFIN="Y" user already answered to provide financial information (module DISC^DGMTSC)
+5 IF $GET(ANSPFIN)="Y"
IF $DATA(DGREF)
Begin DoDot:1
+6 SET (DGINTF,DGNWTF)=""
+7 WRITE !,"DECLINES TO GIVE INCOME INFORMATION: YES"
+8 SET DGREF1=""
+9 QUIT
End DoDot:1
+10 IF ($GET(DGINTF)=0)
IF ($GET(DGNWTF)=0)
SET DGREF1=""
DO REF
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO Q
+11 DO CAT^DGMTSCU2
DO STA^DGMTSCU2
+12 ;don't try to run validation checks if declining to provide financial information
+13 IF '$DATA(DGREF)
DO CHK
IF DGERR
WRITE !?3,*7,$SELECT(DGMTYPT=1:"Means",1:"Copay")_" test cannot be completed."
GOTO Q
+14 IF DGMTYPT=1
IF DGTYC="M"
IF (DGNWT-DGDET)+$SELECT(DGMTNWC:0,1:DGINT)'<$PIECE(DGMTPAR,"^",8)
DO ADJ
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO Q
+15 IF DGMTYPT=2
IF DGCAT="P"
DO ADJ
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO Q
+16 SET DA=DGMTI
SET DIE="^DGMT(408.31,"
SET DIE("NO^")=""
SET DR="[DGMT ENTER/EDIT COMPLETION]"
DO ^DIE
KILL DA,DIE,DR
IF '$DATA(DGFIN)
SET DGERR=1
GOTO Q
+17 IF DGMTACT="EDT"
IF DGMTDT>DT
Begin DoDot:1
+18 NEW DATA
SET (DATA(.01),DATA(.07))=DT
SET DATA(2)=1
IF $$UPD^DGENDBS(408.31,DGMTI,.DATA)
End DoDot:1
+19 if DGMTYPT=1
WRITE !?3,"...means test status is ",$PIECE($$MTS^DGMTU(DFN,DGMTS),"^"),"..."
+20 if DGMTYPT=2
WRITE !?3,"...copay test status is ",$SELECT(DGCAT="E":"EXEMPT",DGCAT="M":"NON-EXEMPT",DGCAT="P":"PENDING ADJUDICATION",1:"INCOMPLETE"),"..."
+21 ;jam; DG*5.3*1064
+22 IF $$INDSTATUS^DGENELA2(DFN)
Begin DoDot:1
+23 DO BLD^DIALOG(261134,"","","","F")
+24 DO MSG^DIALOG("WM","","","")
End DoDot:1
+25 ;
+26 DO PRT
+27 ;
Q KILL DGFIN,DTOUT,DUOUT,Y
+1 QUIT
+2 ;
COM ;Check if user wants to complete the means test
+1 NEW DIR
+2 SET DIR("A")="Do you wish to complete the "_$SELECT(DGMTYPT=1:"means",1:"copay exemption")_" test"
+3 SET DIR("B")="YES"
SET DIR(0)="Y"
DO ^DIR
+4 ; The following was added for LTC Copay Phase II (DG*5.3*433)
+5 IF DGMTYPT=4
IF 'Y
Begin DoDot:1
+6 WRITE !,"NOTE: If you do not complete the LTC copay exemption test, the incomplete test",!?6,"will be deleted."
+7 SET DIR("A")="Do you wish to complete the copay exemption test"
+8 SET DIR("B")="YES"
SET DIR(0)="Y"
DO ^DIR
End DoDot:1
+9 QUIT
+10 ;
REF ;Check if patient declines to provide income information
+1 ;ANSPFIN Y - user already answer this question (see program DGMTSC)
+2 NEW DIR,Y,U
+3 SET U="^"
+4 SET DIR("A")="DECLINES TO GIVE INCOME INFORMATION"
+5 IF $PIECE($GET(^DGMT(408.31,DGMTI,0)),"^",14)]""
SET DIR("B")=$$YN^DGMTSCU1($PIECE(^(0),"^",14))
+6 IF '$DATA(DIR("B"))
IF $GET(ANSPFIN)'="Y"
SET DIR("B")="NO"
+7 ;user answered Y to provide income initially, but didn't provide income information
+8 IF $GET(ANSPFIN)="Y"
SET DIR("B")="YES"
+9 IF $GET(DGINTF)=0
IF $GET(DGNWTF)=0
SET DIR("B")="YES"
+10 SET DIR(0)="408.31,.14"
DO ^DIR
KILL DIR
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO REFQ
+11 if Y
SET DGREF=""
if '$DATA(DGREF)!($DATA(DGREF1))!(DGMTYPT'=1)
QUIT
SET DGCAT="C"
DO STA^DGMTSCU2
+12 SET ANSPFIN="Y"
REFQ QUIT
+1 ;
CHK ;Check if means test can be completed
+1 NEW DGA,DGD,DGDEP,DGREL,DGL,DGM,I
+2 DO GETREL^DGMTU11(DFN,"CS",$$LYR^DGMTSCU1(DGMTDT),$SELECT($GET(DGMTI):DGMTI,1:""))
+3 ;DG*5.3*890
SET DGM=$PIECE(DGVIR0,"^",5)
SET DGL=$PIECE(DGVIR0,"^",6)
SET DGA=$PIECE(DGVIR0,"^",20)
SET DGD=$PIECE(DGVIR0,"^",8)
+4 IF DGM']""!(DGM&(DGL']""))!(DGM&('DGL)&(DGA']""))
WRITE !?3,"Marital section must be completed."
SET DGERR=1
+5 IF DGM
IF '$DATA(DGREL("S"))
IF '$DATA(DGREF)
WRITE !?3,"Married is 'YES'. An active spouse for this means test does not exist."
SET DGERR=1
+6 IF 'DGM
IF $DATA(DGREL("S"))
WRITE !?3,"An active spouse exists for this means test. Married should be 'YES'."
SET DGERR=1
+7 IF DGD']""
WRITE !?3,"Dependent Children section must be completed."
SET DGERR=1
+8 IF DGD
IF '$DATA(DGREL("C"))
WRITE !?3,"Dependent Children is 'YES'. No active children exist."
SET DGERR=1
+9 IF 'DGD
IF $DATA(DGREL("C"))
WRITE !?3,"Active children exist. Dependent Children should be 'YES'."
SET DGERR=1
+10 IF DGMTYPT=1
IF '$DATA(DGREF)
IF DGTYC="M"
IF 'DGNWTF
Begin DoDot:1
+11 ;DG*5.3*1014 check if entry point in screen was from edit, add, or complete a means test
+12 IF DGMTACT'="EDT"&(DGMTACT'="ADD")&(DGMTACT'="COM")
WRITE !?3,"A status of ",$$GETNAME^DGMTH(DGMTS)," requires property information."
SET DGERR=1
End DoDot:1
+13 IF DGMTYPT=2
IF 'DGNWTF
IF DGCAT="E"
IF $$ASKNW^DGMTCOU
WRITE !?3,"Patient is in an 'EXEMPT' status and requires property information."
SET DGERR=1
+14 IF DGDET>DGINT
WRITE !?3,"Patient's deductible expenses cannot exceed income."
SET DGERR=1
+15 if $GET(DGERR)
QUIT
+16 NEW CNT,ACT,DGDEP,FLAG,DGINCP
+17 DO INIT^DGDEP
SET CNT=0
Begin DoDot:1
+18 FOR
SET CNT=$ORDER(DGDEP(CNT))
if 'CNT
QUIT
IF $PIECE(DGDEP(CNT),U,2)="SPOUSE"
Begin DoDot:2
+19 DO GETIENS^DGMTU2(DFN,$PIECE(DGDEP(CNT),U,20),DGMTDT)
+20 SET DGINCP=$GET(^DGMT(408.22,+DGIRI,"MT"))
if DGINCP
SET FLAG=$GET(FLAG)+1
+21 IF $GET(FLAG)>1
WRITE !?3,"Patient has more than one spouse for this means test."
SET DGERR=1
End DoDot:2
if $GET(DGERR)
QUIT
End DoDot:1
+22 QUIT
+23 ;
ADJ ;Adjudicate the means test
+1 ;DG*5.3*1014
IF DGMTACT="EDT"!(DGMTACT="ADD")!(DGMTACT="COM")
QUIT
+2 NEW DIR,Y
+3 SET DIR("?",1)="Since assets exceed the threshold, the "_$SELECT(DGMTYPT=1:"means",1:"copay")_" test can"
+4 SET DIR("?",2)="be sent to adjudication. If the "_$SELECT(DGMTYPT=1:"means",1:"copay")_" test is not"
+5 SET DIR("?")="adjudicated, the patient will be placed in "_$SELECT(DGMTYPT=1&(DGTHG>DGTHA):"GMT Copay Required",DGMTYPT=1:"MT Copay Required",1:"Non-exempt")_" status."
+6 SET DIR("A")="Do you wish to send this case to adjudication"
+7 SET DIR("B")="YES"
SET DIR(0)="Y"
DO ^DIR
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO ADJQ
+8 SET DGCAT=$SELECT(Y:"P",DGMTYPT=1&(DGTHG>DGTHA):"G",DGMTYPT=1:"C",1:"N")
DO STA^DGMTSCU2
ADJQ QUIT
+1 ;
+2 ;DG*5.3*624 - REMOVE 10-10F AND REPLACE WITH 10-10EZ/EZR
PRT ;Print the 10-10EZR or 10-10EZ
+1 NEW EZFLAG
+2 IF $DATA(DGFINOP)
Begin DoDot:1
+3 WRITE !!,"Options for printing financial assessment information will follow."
+4 WRITE !,"Generally, you should answer 'YES' to 'PRINT 10-10EZR?' after updating"
+5 WRITE !,"patient demographic or financial information. Answer 'YES' to 'PRINT"
+6 WRITE !,"10-10EZ?' after entering new patient demographic and financial information."
End DoDot:1
+7 SET EZFLAG=$$SEL1010^DG1010P("EZR/EZ")
+8 if (EZFLAG=-1)
QUIT
+9 DO QUE
+10 ;
PRTQ QUIT
+1 ;
+2 ;DG*5.3*624 - REMOVE 10-10F AND REPLACE WITH 10-10EZ/EZR
QUE ;
+1 NEW X
+2 IF $GET(EZFLAG)="EZ"
SET X=$$ENEZ^EASEZPDG(DFN,DGMTI)
+3 IF $GET(EZFLAG)="EZR"
SET X=$$ENEZR^EASEZPDG(DFN,DGMTI)
+4 QUIT
