Changeset 623 for WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTCOU1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTCOU1.m
r613 r623 1 DGMTCOU1 2 ;;5.3;Registration;**33,45,54,335,358,401,436,445,564,634**;Aug 13, 1993;Build 30 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 AUTO(DFN,AUTOEX) 20 21 22 23 24 25 26 27 28 29 AUTOINFO(DFN) 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 QTAUTO 54 55 LST(DFN,DGDT,DGMTYPT1) 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 THRESH(DGDT) 73 74 75 76 77 78 79 80 81 82 83 84 85 THRESHQT 86 DISPMAS(DFN) 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 LST365(DFN,DGDT,DGMTYPT1) 103 104 105 106 107 108 109 110 111 112 113 114 365(X1,DGDT) 115 1 DGMTCOU1 ;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 19 AUTO(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" 29 AUTOINFO(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 53 QTAUTO Q DGX 54 ; 55 LST(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) 72 THRESH(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) 85 THRESHQT Q 86 DISPMAS(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 102 LST365(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 114 365(X1,DGDT) ; RETURNS 1 IF X1 IS MORE THAN 1 YEAR BEFORE DGDT 115 Q X1+10000'>DGDT
Note:
See TracChangeset
for help on using the changeset viewer.
