DGMTSCC ;ALB/RMO,CAW,LBD,EG - Means Test Screen Completion ; 03/24/2006
;;5.3;Registration;**33,45,130,438,332,433,462,456,610,624,611,1015**;Aug 13, 1993;Build 21
;
; 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"),"..."
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,"^",7),DGD=$P(DGVIR0,"^",8)
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 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
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
DGMTSCC ;ALB/RMO,CAW,LBD,EG - Means Test Screen Completion ; 03/24/2006
+1 ;;5.3;Registration;**33,45,130,438,332,433,462,456,610,624,611,1015**;Aug 13, 1993;Build 21
+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 DO PRT
+22 ;
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 SET DGM=$PIECE(DGVIR0,"^",5)
SET DGL=$PIECE(DGVIR0,"^",6)
SET DGA=$PIECE(DGVIR0,"^",7)
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
WRITE !?3,"A status of ",$$GETNAME^DGMTH(DGMTS)," requires property information."
SET DGERR=1
+11 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
+12 IF DGDET>DGINT
WRITE !?3,"Patient's deductible expenses cannot exceed income."
SET DGERR=1
+13 IF $GET(DGERR)
QUIT
+14 NEW CNT,ACT,DGDEP,FLAG,DGINCP
+15 DO INIT^DGDEP
SET CNT=0
Begin DoDot:1
+16 FOR
SET CNT=$ORDER(DGDEP(CNT))
IF 'CNT
QUIT
IF $PIECE(DGDEP(CNT),U,2)="SPOUSE"
Begin DoDot:2
+17 DO GETIENS^DGMTU2(DFN,$PIECE(DGDEP(CNT),U,20),DGMTDT)
+18 SET DGINCP=$GET(^DGMT(408.22,+DGIRI,"MT"))
IF DGINCP
SET FLAG=$GET(FLAG)+1
+19 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
+20 QUIT
+21 ;
ADJ ;Adjudicate the means test
+1 NEW DIR,Y
+2 SET DIR("?",1)="Since assets exceed the threshold, the "_$SELECT(DGMTYPT=1:"means",1:"copay")_" test can"
+3 SET DIR("?",2)="be sent to adjudication. If the "_$SELECT(DGMTYPT=1:"means",1:"copay")_" test is not"
+4 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."
+5 SET DIR("A")="Do you wish to send this case to adjudication"
+6 SET DIR("B")="YES"
SET DIR(0)="Y"
DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO ADJQ
+7 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
