source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTSCC.m@ 1697

Last change on this file since 1697 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.0 KB
Line 
1DGMTSCC ;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 ;
15EN 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 ;
38Q K DGFIN,DTOUT,DUOUT,Y
39 Q
40 ;
41COM ;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 ;
52REF ;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"
65REFQ Q
66 ;
67CHK ;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 ;
89ADJ ;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
97ADJQ Q
98 ;
99 ;DG*5.3*624 - REMOVE 10-10F AND REPLACE WITH 10-10EZ/EZR
100PRT ;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 ;
111PRTQ Q
112 ;
113 ;DG*5.3*624 - REMOVE 10-10F AND REPLACE WITH 10-10EZ/EZR
114QUE ;
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
Note: See TracBrowser for help on using the repository browser.