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

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1DGMTCOR ;ALB/CAW,SCG,LBD - Check Copay Test Requirements ; 03/03/03 8:15am
2 ;;5.3;Registration;**21,45,182,290,305,330,344,495,564**;Aug 13, 1993
3 ;
4 ;A patient may apply for a copay test under the following conditions:
5 ; - Applicant is a veteran
6 ; - Applicant's primary or other eligibility does NOT contain
7 ; - Service Connected 50% to 100% or
8 ; - Aid and Attendance or
9 ; - Housebound or
10 ; - VA Pension
11 ; - Primary Eligibility is NSC
12 ; - who has NOT been means tested
13 ; - who claims exposure to agent orange or ionizing radiation
14 ; - who is eligible for medicaid
15 ; - Applicants who have answered 'no' to Receiving A&A, HB, or Pension
16 ; - Applicants who have previously qualified and applied for a copay
17 ; exemption, still qualify and have NOT been copay tested in the
18 ; past year
19 ; - Applicants who are not currently a DOM patient or inpatient
20 ; (they are temporarily exempt from copay testing) DG*5.3*290
21 ; - Applicants who do not have POW eligibility (DG*5.3*564 - HVE III)
22 ; - Applicants who do not meet criteria for Unemployable:
23 ; Unemployable="Y", SC%>0, not receiving A&A, HB or Pension, and
24 ; Total VA Check Amount>0 (DG*5.3*564 - HVE III)
25 ;
26 ; Input -- DFN Patient IEN
27 ; DGADDF Means Test Add Flag (optional)
28 ; Output -- DGMTCOR Copay Test Flag
29 ; (1 if eligible and 0 if not eligible)
30 ;
31 ;
32EN ;
33 Q:$G(VAFCA08)=1
34 N DGMTI,DGMTYPT,DGMDOD
35 D ON^DGMTCOU G:'Y ENQ
36 S DGRGAUTO=1 ;possible change in cp status w/o call to cp event driver
37 D CHK
38 ;
39 Q:($G(DGWRT)=8)!($G(DGWRT)=9) ;brm;quit if inpatient or dom;DG*5.3*290
40 S IVMZ10F=+$G(IVMZ10F)
41 I 'DGMTCOR,'$G(DGADDF),'$G(DGMDOD),'IVMZ10F D NLA
42 I DGMTCOR,'$G(DGADDF),'$G(DGMDOD) D INC
43 I DGRGAUTO&'$G(DGADDF) D QREGAUTO ;if cp event driver not fired off & NOT a new means test
44 ;
45ENQ Q
46 ;
47CHK N STATUS,DGELIG,DGE,DGI,DGNODE,DGMDOD,DGMTDT,DGMTI,DGMTL
48 S DGMTCOR=1,DGMT="",DGMTYPT=2
49 I $P($G(^DPT(DFN,"VET")),U,1)'="Y" S DGMTCOR=0,DGWRT=1 G CHKQ ;NON-VET
50 ;Added with DG*5.3*344
51 S DGMTL=$$LST^DGMTU(DFN),DGMTI=+DGMTL,DGMTDT=$P(DGMTL,U,2)
52 S DGMDOD=$P($G(^DPT(DFN,.35)),U)
53 I 'DGMTI,$G(DGMDOD) S DGMTCOR=0 Q
54 I DGMDOD,(DGMTCOR),(DGMTDT>(DGMDOD-1)) S DGMTCOR=0 G CHKQ
55 ;
56 I '$P($G(^DPT(DFN,.36)),U) S DGMTCOR=0,DGWRT=2 G CHKQ ;NO PRIM ELIG
57 I +$G(DGMDOD) S DGNOCOPF=1
58 ;
59 ;This doesn't work! The "AEL" x-ref not there when changing the primary
60 ;eligibility! Problem with order that the cross-references are called
61 ;in, DGMTR is called before the "AEL" x-ref is set!
62 ;F S DGMTI=$O(^DPT("AEL",DFN,DGMTI)) Q:'DGMTI S DGMTE=$P($G(^DIC(8,DGMTI,0)),U,9) I "^1^2^4^15^"[("^"_DGMTE_"^") S DGMTCOR=0,DGWRT=3 G CHKQ
63 ;
64 ;
65 S DGI=$P($G(^DPT(DFN,.36)),"^"),DGELIG=U_$P($G(^DIC(8,+DGI,0)),U,9)_U
66 S DGI=0 F S DGI=$O(^DPT(DFN,"E",DGI)) Q:'DGI S DGE=$P($G(^DPT(DFN,"E",DGI,0)),U),DGELIG=DGELIG_$P($G(^DIC(8,+DGE,0)),U,9)_U
67 I (DGELIG["^1^") S DGMTCOR=0,DGWRT=3 G CHKQ ;SC 50-100%
68 F DGI=.3,.362,.52 S DGNODE(DGI)=$G(^DPT(DFN,DGI))
69 I $P(DGNODE(.362),U,12)["Y"!(DGELIG["^2^") S DGMTCOR=0,DGWRT=5 G CHKQ ;A&A
70 I $P(DGNODE(.362),U,13)["Y"!(DGELIG["^15^") S DGMTCOR=0,DGWRT=6 G CHKQ ;HB
71 I $P(DGNODE(.362),U,14)["Y"!(DGELIG["^4^") S DGMTCOR=0,DGWRT=7 G CHKQ ;PENSION
72 I $P(DGNODE(.52),U,5)["Y"!(DGELIG["^18^") S DGMTCOR=0,DGWRT=10 G CHKQ ;POW (DG*5.3*564)
73 I $P(DGNODE(.3),U,5)["Y"&($P(DGNODE(.3),U,2)>0)&($P(DGNODE(.362),U,20)>0) S DGMTCOR=0,DGWRT=11 G CHKQ ;UNEMPLOYABLE (DG*5.3*564)
74 ;brm added next 3 lines for DG*5.3*290
75 N DGDOM,DGDOM1,VAHOW,VAROOT,VAINDT,VAIP,VAERR,NOW
76 D DOM^DGMTR I $G(DGDOM) S DGMTCOR=0,DGRGAUTO=0,DGWRT=8 Q ;DOM
77 D IN5^VADPT I $G(VAIP(1))'="" S DGMTCOR=0,DGRGAUTO=0,DGWRT=9 Q ;INP
78 I DGMTI,'$$OLD^DGMTU4(DGMTDT) S STATUS=$P($G(^DGMT(408.31,+DGMTI,0)),U,3) I STATUS'="3" S DGMTCOR=0,DGWRT=4 G CHKQ
79CHKQ Q
80 ;
81NLA ; Change Status to NO LONGER APPLICABLE - if appropriate
82 ;
83 N DGCS,DGMTI,DGMT0,DGINI,DGINR,DGVAL,DGFL,DGFLD,DGIEN,DGMTACT,TDATE
84 S DGMTI=+$$LST^DGMTU(DFN,"",2) Q:'DGMTI!($P($G(^DGMT(408.31,DGMTI,0)),U,3)=10)
85 S DGMT0=$G(^DGMT(408.31,DGMTI,0)) Q:'DGMT0
86 S DGCS=$P(DGMT0,U,3)
87 S TDATE=+DGMT0
88 S DGMTACT="STA" D PRIOR^DGMTEVT
89 ;
90 D SAVESTAT^DGMTU4(DGMTI)
91 ;
92 S DGFL=408.31,DGIEN=DGMTI
93 S DGFLD=.03 I DGCS]"" S DGVAL=DGCS D KILL^DGMTR
94 S DGVAL=10,$P(^DGMT(408.31,DGMTI,0),"^",3)=DGVAL D SET^DGMTR
95 S DGFLD=.17,DGVAL=DT,$P(^DGMT(408.31,DGMTI,0),"^",17)=DT D SET^DGMTR
96 W:'$G(DGMTMSG)&'$D(ZTQUEUED) !,"COPAY TEST NO LONGER APPLICABLE"
97 D GETINCOM^DGMTU4(DFN,TDATE)
98 S DGMTYPT=2 D QUE^DGMTR
99 S DGRGAUTO=0
100NLAQ Q
101 ;
102INC ;Update copay status to 'INCOMPLETE' if applicable OR restore completed test
103 N DGMTACT,DGMTI,DGFL,DGFLD,DGIEN,DGMTP,DGVAL,DGMT0,AUTOCOMP,ERROR
104 S AUTOCOMP=0
105 S DGMTI=+$$LST^DGMTU(DFN,"",2)
106 D
107 .Q:'DGMTI
108 .I ($P($G(^DGMT(408.31,DGMTI,0)),U,3)'=10) S AUTOCOMP=1 Q
109 .S DGMT0=$G(^DGMT(408.31,DGMTI,0)),DGCS=$P(DGMT0,U,3)
110 .Q:'DGMT0
111 .S DGMTACT="STA" D PRIOR^DGMTEVT
112 .S AUTOCOMP=$$AUTOCOMP^DGMTR(DGMTI)
113 .W:'AUTOCOMP&'$G(DGMTMSG)&'$D(ZTQUEUED) !,"COPAY EXEMPTION TEST UPDATED TO INCOMPLETE"
114 .W:AUTOCOMP&'$G(DGMTMSG)&'$D(ZTQUEUED) !,"COPAY EXEMPTION TEST UPDATED TO ",$$GETNAME^DGMTH($P($G(^DGMT(408.31,DGMTI,0)),"^",3))
115 .S DGMTYPT=2 D QUE^DGMTR
116 .S DGRGAUTO=0
117 ;
118 I $G(IVMZ10)'="UPLOAD IN PROGRESS",$G(DGQSENT)'=1,'AUTOCOMP,'$$OPEN^IVMCQ2(DFN),'$$SENT^IVMCQ2(DFN) D QRYQUE2^IVMCQ2(DFN,$G(DUZ),0,$G(XQY)) S DGQSENT=1 I '$D(ZTQUEUED),'$G(DGMSGF) W !!,"Financial query queued to be sent to HEC..."
119 ;
120INCQ Q
121 ;
122QREGAUTO ;Queues off test done by IB recalculating CP status
123 ; Input: DFN
124 ; Action: Possible update of Copay Status
125 ;
126 Q:'$D(^IBA(354.1,"APIDT",DFN,1)) ;No action if no status on file
127 S ZTDESC="CHECK PATIENT FILE CHANGES VS CP STATUS",ZTDTH=$H,ZTRTN="REGAUTO^IBARXEU5",ZTSAVE("DFN")="",ZTIO=""
128 D ^%ZTLOAD
129 K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
130 Q
Note: See TracBrowser for help on using the repository browser.