1 | DGMTSCC ;ALB/RMO,CAW,LBD,EG - Means Test Screen Completion ; 03/24/2006
|
---|
2 | ;;5.3;Registration;**33,45,130,438,332,433,462,456,610,624,611**;Aug 13, 1993;Build 3
|
---|
3 | ;
|
---|
4 | ; Input -- DFN Patient IEN
|
---|
5 | ; DGMTACT Means Test Action
|
---|
6 | ; DGMTDT Date of Test
|
---|
7 | ; DGMTYPT Type of Test 1=MT 2=COPAY
|
---|
8 | ; DGMTPAR Annual Means Test Parameters
|
---|
9 | ; DGVINI Veteran Individual Annual Income IEN
|
---|
10 | ; DGVIRI Veteran Income Relation IEN
|
---|
11 | ; DGVPRI Veteran Patient Relation IEN
|
---|
12 | ; DGMTNWC Net Worth Calculation flag
|
---|
13 | ; Output -- DGERR 1=INCOMPLETE and 0=COMPLETE
|
---|
14 | ;
|
---|
15 | 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
|
---|
16 | S DGERR=0
|
---|
17 | I DGMTACT="ADD" D COM I 'Y!($D(DTOUT))!($D(DUOUT)) G Q
|
---|
18 | S DGCOMF=1 D DEP^DGMTSCU2,INC^DGMTSCU3
|
---|
19 | ;if ANSPFIN="Y" user already answered to provide financial information (module DISC^DGMTSC)
|
---|
20 | I $G(ANSPFIN)="Y",$D(DGREF) D
|
---|
21 | . S (DGINTF,DGNWTF)=""
|
---|
22 | . W !,"DECLINES TO GIVE INCOME INFORMATION: YES"
|
---|
23 | . S DGREF1=""
|
---|
24 | . Q
|
---|
25 | I ($G(DGINTF)=0),($G(DGNWTF)=0) S DGREF1="" D REF G Q:$D(DTOUT)!($D(DUOUT))
|
---|
26 | D CAT^DGMTSCU2,STA^DGMTSCU2
|
---|
27 | ;don't try to run validation checks if declining to provide financial information
|
---|
28 | I '$D(DGREF) D CHK I DGERR W !?3,*7,$S(DGMTYPT=1:"Means",1:"Copay")_" test cannot be completed." G Q
|
---|
29 | I DGMTYPT=1,DGTYC="M",(DGNWT-DGDET)+$S(DGMTNWC:0,1:DGINT)'<$P(DGMTPAR,"^",8) D ADJ G Q:$D(DTOUT)!($D(DUOUT))
|
---|
30 | I DGMTYPT=2,DGCAT="P" D ADJ G Q:$D(DTOUT)!($D(DUOUT))
|
---|
31 | 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
|
---|
32 | I DGMTACT="EDT",DGMTDT>DT D
|
---|
33 | . N DATA S (DATA(.01),DATA(.07))=DT,DATA(2)=1 I $$UPD^DGENDBS(408.31,DGMTI,.DATA)
|
---|
34 | W:DGMTYPT=1 !?3,"...means test status is ",$P($$MTS^DGMTU(DFN,DGMTS),"^"),"..."
|
---|
35 | W:DGMTYPT=2 !?3,"...copay test status is ",$S(DGCAT="E":"EXEMPT",DGCAT="M":"NON-EXEMPT",DGCAT="P":"PENDING ADJUDICATION",1:"INCOMPLETE"),"..."
|
---|
36 | D PRT
|
---|
37 | ;
|
---|
38 | Q K DGFIN,DTOUT,DUOUT,Y
|
---|
39 | Q
|
---|
40 | ;
|
---|
41 | COM ;Check if user wants to complete the means test
|
---|
42 | N DIR
|
---|
43 | S DIR("A")="Do you wish to complete the "_$S(DGMTYPT=1:"means",1:"copay exemption")_" test"
|
---|
44 | S DIR("B")="YES",DIR(0)="Y" D ^DIR
|
---|
45 | ; The following was added for LTC Copay Phase II (DG*5.3*433)
|
---|
46 | I DGMTYPT=4,'Y D
|
---|
47 | . W !,"NOTE: If you do not complete the LTC copay exemption test, the incomplete test",!?6,"will be deleted."
|
---|
48 | . S DIR("A")="Do you wish to complete the copay exemption test"
|
---|
49 | . S DIR("B")="YES",DIR(0)="Y" D ^DIR
|
---|
50 | Q
|
---|
51 | ;
|
---|
52 | REF ;Check if patient declines to provide income information
|
---|
53 | ;ANSPFIN Y - user already answer this question (see program DGMTSC)
|
---|
54 | N DIR,Y,U
|
---|
55 | S U="^"
|
---|
56 | S DIR("A")="DECLINES TO GIVE INCOME INFORMATION"
|
---|
57 | I $P($G(^DGMT(408.31,DGMTI,0)),"^",14)]"" S DIR("B")=$$YN^DGMTSCU1($P(^(0),"^",14))
|
---|
58 | I '$D(DIR("B")),$G(ANSPFIN)'="Y" S DIR("B")="NO"
|
---|
59 | ;user answered Y to provide income initially, but didn't provide income information
|
---|
60 | I $G(ANSPFIN)="Y" S DIR("B")="YES"
|
---|
61 | I $G(DGINTF)=0,$G(DGNWTF)=0 S DIR("B")="YES"
|
---|
62 | S DIR(0)="408.31,.14" D ^DIR K DIR G REFQ:$D(DTOUT)!($D(DUOUT))
|
---|
63 | S:Y DGREF="" Q:'$D(DGREF)!($D(DGREF1))!(DGMTYPT'=1) S DGCAT="C" D STA^DGMTSCU2
|
---|
64 | S ANSPFIN="Y"
|
---|
65 | REFQ Q
|
---|
66 | ;
|
---|
67 | CHK ;Check if means test can be completed
|
---|
68 | N DGA,DGD,DGDEP,DGREL,DGL,DGM,I
|
---|
69 | D GETREL^DGMTU11(DFN,"CS",$$LYR^DGMTSCU1(DGMTDT),$S($G(DGMTI):DGMTI,1:""))
|
---|
70 | S DGM=$P(DGVIR0,"^",5),DGL=$P(DGVIR0,"^",6),DGA=$P(DGVIR0,"^",7),DGD=$P(DGVIR0,"^",8)
|
---|
71 | I DGM']""!(DGM&(DGL']""))!(DGM&('DGL)&(DGA']"")) W !?3,"Marital section must be completed." S DGERR=1
|
---|
72 | 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
|
---|
73 | I 'DGM,$D(DGREL("S")) W !?3,"An active spouse exists for this means test. Married should be 'YES'." S DGERR=1
|
---|
74 | I DGD']"" W !?3,"Dependent Children section must be completed." S DGERR=1
|
---|
75 | I DGD,'$D(DGREL("C")) W !?3,"Dependent Children is 'YES'. No active children exist." S DGERR=1
|
---|
76 | I 'DGD,$D(DGREL("C")) W !?3,"Active children exist. Dependent Children should be 'YES'." S DGERR=1
|
---|
77 | I DGMTYPT=1,'$D(DGREF),DGTYC="M",'DGNWTF W !?3,"A status of ",$$GETNAME^DGMTH(DGMTS)," requires property information." S DGERR=1
|
---|
78 | I DGMTYPT=2,'DGNWTF,DGCAT="E",$$ASKNW^DGMTCOU W !?3,"Patient is in an 'EXEMPT' status and requires property information." S DGERR=1
|
---|
79 | I DGDET>DGINT W !?3,"Patient's deductible expenses cannot exceed income." S DGERR=1
|
---|
80 | Q:$G(DGERR)
|
---|
81 | N CNT,ACT,DGDEP,FLAG,DGINCP
|
---|
82 | D INIT^DGDEP S CNT=0 D
|
---|
83 | . F S CNT=$O(DGDEP(CNT)) Q:'CNT I $P(DGDEP(CNT),U,2)="SPOUSE" D Q:$G(DGERR)
|
---|
84 | . . D GETIENS^DGMTU2(DFN,$P(DGDEP(CNT),U,20),DGMTDT)
|
---|
85 | . . S DGINCP=$G(^DGMT(408.22,+DGIRI,"MT")) S:DGINCP FLAG=$G(FLAG)+1
|
---|
86 | . . I $G(FLAG)>1 W !?3,"Patient has more than one spouse for this means test." S DGERR=1
|
---|
87 | Q
|
---|
88 | ;
|
---|
89 | ADJ ;Adjudicate the means test
|
---|
90 | N DIR,Y
|
---|
91 | S DIR("?",1)="Since assets exceed the threshold, the "_$S(DGMTYPT=1:"means",1:"copay")_" test can"
|
---|
92 | S DIR("?",2)="be sent to adjudication. If the "_$S(DGMTYPT=1:"means",1:"copay")_" test is not"
|
---|
93 | 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."
|
---|
94 | S DIR("A")="Do you wish to send this case to adjudication"
|
---|
95 | S DIR("B")="YES",DIR(0)="Y" D ^DIR G ADJQ:$D(DTOUT)!($D(DUOUT))
|
---|
96 | S DGCAT=$S(Y:"P",DGMTYPT=1&(DGTHG>DGTHA):"G",DGMTYPT=1:"C",1:"N") D STA^DGMTSCU2
|
---|
97 | ADJQ Q
|
---|
98 | ;
|
---|
99 | ;DG*5.3*624 - REMOVE 10-10F AND REPLACE WITH 10-10EZ/EZR
|
---|
100 | PRT ;Print the 10-10EZR or 10-10EZ
|
---|
101 | N EZFLAG
|
---|
102 | I $D(DGFINOP) DO
|
---|
103 | .W !!,"Options for printing financial assessment information will follow."
|
---|
104 | .W !,"Generally, you should answer 'YES' to 'PRINT 10-10EZR?' after updating"
|
---|
105 | .W !,"patient demographic or financial information. Answer 'YES' to 'PRINT"
|
---|
106 | .W !,"10-10EZ?' after entering new patient demographic and financial information."
|
---|
107 | S EZFLAG=$$SEL1010^DG1010P("EZR/EZ")
|
---|
108 | Q:(EZFLAG=-1)
|
---|
109 | D QUE
|
---|
110 | ;
|
---|
111 | PRTQ Q
|
---|
112 | ;
|
---|
113 | ;DG*5.3*624 - REMOVE 10-10F AND REPLACE WITH 10-10EZ/EZR
|
---|
114 | QUE ;
|
---|
115 | N X
|
---|
116 | I $G(EZFLAG)="EZ" S X=$$ENEZ^EASEZPDG(DFN,DGMTI)
|
---|
117 | I $G(EZFLAG)="EZR" S X=$$ENEZR^EASEZPDG(DFN,DGMTI)
|
---|
118 | Q
|
---|