Routine: DGMTSCC

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

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

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

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)

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

DGMTSCC.m