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

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

revised back to 6/30/08 version
File size: 4.9 KB
RevLine 
[623]1DGMTCOU1 ;ALB/REW,LD,JAN,AEG,LBD - COPAY UTILITIES ;11/5/06 20:29
2 ;;5.3;Registration;**33,45,54,335,358,401,436,445,564,634**;Aug 13, 1993;Build 28
3 ; Modified from FOIA VISTA,
4 ; Copyright (C) 2007 WorldVistA
5 ;
6 ; This program is free software; you can redistribute it and/or modify
7 ; it under the terms of the GNU General Public License as published by
8 ; the Free Software Foundation; either version 2 of the License, or
9 ; (at your option) any later version.
10 ;
11 ; This program is distributed in the hope that it will be useful,
12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ; GNU General Public License for more details.
15 ;
16 ; You should have received a copy of the GNU General Public License
17 ; along with this program; if not, write to the Free Software
18 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
19AUTO(DFN,AUTOEX) ;
20 ; Returns 1 if Exempt from CP w/o needing MT/CP information
21 ; INPUT: DFN [Required]
22 ; AUTOEX [Optional]
23 ; RETURNS 1=Exempt 0=Not Exempt
24 ;
25 ; Hold the Auto exclusion information for later use
26 S AUTOEX=$$AUTOINFO(DFN)
27 ;
28 Q AUTOEX["1"
29AUTOINFO(DFN) ;
30 ; This returns info needed to IB to see if MT information needs to be
31 ; looked at to determine Copay Exemption Status
32 ;
33 ; INPUT: DFN - IEN of Patient File (Required)
34 ; OUTPUT: (SC>50%^REC.A&A^REC.HB^REC.PEN^DOM PT^NON.VET^INPT^POW^UNEMP)
35 ; Piece: ( 1 ^ 2 ^ 3 ^ 4 ^ 5 ^ 6 ^ 7 ^ 8 ^ 9 )
36 ; PIECES =1 IF TRUE
37 ;
38 N DGALLEL,DGDOM,DGEL,DGNODE,DGX,DGYR,VADMVT,DGI
39 S DGX=""
40 I $P($G(^DPT(DFN,"VET")),U,1)'="Y" S $P(DGX,U,6)=1 G QTAUTO ;NON-VET
41 S DGEL=0,DGALLEL=U
42 F S DGEL=$O(^DPT("AEL",DFN,DGEL)) Q:'DGEL S DGALLEL=DGALLEL_$P($G(^DIC(8,DGEL,0)),U,9)_U
43 F DGI=.3,.362,.52 S DGNODE(DGI)=$G(^DPT(DFN,DGI))
44 I (DGALLEL["^1^") S $P(DGX,U,1)=1 G QTAUTO ;SC>50
45 I $P(DGNODE(.362),U,12)["Y"!(DGALLEL["^2^") S $P(DGX,U,2)=1 G QTAUTO ;A&A
46 I $P(DGNODE(.362),U,13)["Y"!(DGALLEL["^15^") S $P(DGX,U,3)=1 G QTAUTO ;HB
47 I $P(DGNODE(.362),U,14)["Y"!(DGALLEL["^4^") S $P(DGX,U,4)=1 G QTAUTO ;PENSION
48 I $P(DGNODE(.52),U,5)["Y"!(DGALLEL["^18^") S $P(DGX,U,8)=1 G QTAUTO ;POW
49 I $P(DGNODE(.3),U,5)["Y"&($P(DGNODE(.3),U,2)>0)&($P(DGNODE(.362),U,20)>0) S $P(DGX,U,9)=1 G QTAUTO ;UNEMPLOYABLE
50 N DGDOM,DGDOM1,VAHOW,VAROOT,VAINDT,VAIP,VAERR
51 D DOM^DGMTR I $G(DGDOM) S $P(DGX,U,5)=1 G QTAUTO ;DOM
52 D IN5^VADPT I $G(VAIP(1))'="" S $P(DGX,U,7)=1 G QTAUTO ;INPAT
53QTAUTO Q DGX
54 ;
55LST(DFN,DGDT,DGMTYPT1) ;Last Copay Exemption or Means Test for a patient
56 ; Input -- DFN Patient IEN
57 ; DGDT Date/Time (Optional- default today@2359)
58 ; DGMTYPT1 (Optional (1:MT, 2:CP, Null/Default or 3:Either)
59 ; Output -- MT IEN^Date of Test ^Status Name^Status Code^Type of Test
60 ; Piece: 1 ^ 2 3 4 5
61 ;
62 N DGCPDT,DGIDT,DGIDT,DGMTDT,DGMTI,Y
63 S DGIDT=$S($G(DGDT)>0:-DGDT,1:-DT) S:'$P(DGIDT,".",2) DGIDT=DGIDT_.2359
64 I '$D(DGMTYPT1) S DGMTYPT1=3
65 I DGMTYPT1=3 D ;EITHER
66 .S DGMTDT=+$O(^DGMT(408.31,"AID",1,DFN,DGIDT))
67 .S DGCPDT=+$O(^DGMT(408.31,"AID",2,DFN,DGIDT))
68 .S DGMTYPT1=$S(DGCPDT<DGMTDT:2,(DGCPDT>DGMTDT):1,$D(^DGMT(408.31,"AS",1,3,+DGMTDT,DFN)):2,1:1)
69 S DGMTI=+$$LST^DGMTU(DFN,$P(DGIDT,"-",2),DGMTYPT1)
70 I $D(^DGMT(408.31,DGMTI,0)) S Y=DGMTI_"^"_$P(^(0),"^")_"^"_$$MTS^DGMTU(DFN,+$P(^(0),"^",3))_"^"_DGMTYPT1
71 Q $G(Y)
72THRESH(DGDT) ;PRINTS THE YEAR'S COPAY THRESHOLDS
73 ;UPDATE 11/15/00 TO REFLECT YEAR'S COPAY THRESHOLDS PER VHA DIRECTIVE
74 ;99-064
75 N DGCPLEV,DGDEP,DGNODE,DGTYPE,Y
76 I '$D(DGDT) S DGDT=DT
77 S DGDT=DGDT\1
78 S Y=DGDT X ^DD("DD") W !,?2,"Net Annual Income Thresholds on ",Y,":"
79 S DGTYPE=$S(DGDT<2961201:2,1:1)
80 S DGCPLEV=$$THRES^IBARXEU1(DGDT,DGTYPE,0)
81 I DGCPLEV']"" W !,"None for this date..." G THRESHQT
82 W !,?5,"Num. Dependents: ",?25,"0 (Self)",?42,1,?52,2,?62,3,?72,4
83 W !,?5,"Net Income:"
84 F DGDEP=0:1:4 W ?(23+(DGDEP*10)),$J(+$$THRES^IBARXEU1(DGDT,DGTYPE,DGDEP),10)
85THRESHQT Q
86DISPMAS(DFN) ; Displays Co
87 ;New EHR code ;DAOU/JLG 2/4/05
88 ;not relevant to Agency EHR
89 Q:$G(DUZ("AG"))="E"
90 ;End EHR modifications
91 N DGCPS,DGEX,Y,AUTOEX
92 S DGEX=$$AUTO(DFN,.AUTOEX)
93 I $P($G(AUTOEX),U,5)!($P($G(AUTOEX),U,7)) Q
94 I DGEX W !,"Patient is exempt from Copay."
95 I 'DGEX D
96 .S DGCPS=$$LST365(DFN,DT,2),Y=$P(DGCPS,U,2)
97 .I DGCPS]"" D
98 ..X ^DD("DD")
99 ..W !,"Patient's Copay Status is ",$P(DGCPS,U,3)
100 ..W ". Last Test Date: ",Y,"."
101 Q
102LST365(DFN,DGDT,DGMTYPT1) ;RETURNS CURRENT MT/CP (WITHIN 365 DAYS)
103 ; Input: DGDT - IB DATE
104 ; DGMTYPT1 (Optional (1:MT, 2:CP, Null/Default or 3:Either)
105 ; Output -- MT IEN^Date of Test ^Status Name^Status Code^Type of Test
106 ; Piece: 1 ^ 2 3 4 5
107 N DGLST
108 S DGDT=$G(DGDT)
109 I '$D(DGMTYPT1) S DGMTYPT1=3
110 S DGLST=$$LST(DFN,DGDT,DGMTYPT1)
111 S:$P(DGLST,U,4)="N" DGLST=$$LST(DFN,DGDT,2)
112 S:$$365($P(DGLST,U,2),DGDT) DGLST="" ;RETURN NULL IF LAST >365
113 Q DGLST
114365(X1,DGDT) ; RETURNS 1 IF X1 IS MORE THAN 1 YEAR BEFORE DGDT
115 Q X1+10000'>DGDT
Note: See TracBrowser for help on using the repository browser.