| 1 | DGMTCOU1 ;ALB/REW,LD,JAN,AEG,LBD - COPAY UTILITIES ; 8/13/04 8:31am
|
|---|
| 2 | ;;5.3;Registration;**33,45,54,335,358,401,436,445,564**;Aug 13, 1993
|
|---|
| 3 | AUTO(DFN,AUTOEX) ;
|
|---|
| 4 | ; Returns 1 if Exempt from CP w/o needing MT/CP information
|
|---|
| 5 | ; INPUT: DFN [Required]
|
|---|
| 6 | ; AUTOEX [Optional]
|
|---|
| 7 | ; RETURNS 1=Exempt 0=Not Exempt
|
|---|
| 8 | ;
|
|---|
| 9 | ; Hold the Auto exclusion information for later use
|
|---|
| 10 | S AUTOEX=$$AUTOINFO(DFN)
|
|---|
| 11 | ;
|
|---|
| 12 | Q AUTOEX["1"
|
|---|
| 13 | AUTOINFO(DFN) ;
|
|---|
| 14 | ; This returns info needed to IB to see if MT information needs to be
|
|---|
| 15 | ; looked at to determine Copay Exemption Status
|
|---|
| 16 | ;
|
|---|
| 17 | ; INPUT: DFN - IEN of Patient File (Required)
|
|---|
| 18 | ; OUTPUT: (SC>50%^REC.A&A^REC.HB^REC.PEN^DOM PT^NON.VET^INPT^POW^UNEMP)
|
|---|
| 19 | ; Piece: ( 1 ^ 2 ^ 3 ^ 4 ^ 5 ^ 6 ^ 7 ^ 8 ^ 9 )
|
|---|
| 20 | ; PIECES =1 IF TRUE
|
|---|
| 21 | ;
|
|---|
| 22 | N DGALLEL,DGDOM,DGEL,DGNODE,DGX,DGYR,VADMVT,DGI
|
|---|
| 23 | S DGX=""
|
|---|
| 24 | I $P($G(^DPT(DFN,"VET")),U,1)'="Y" S $P(DGX,U,6)=1 G QTAUTO ;NON-VET
|
|---|
| 25 | S DGEL=0,DGALLEL=U
|
|---|
| 26 | F S DGEL=$O(^DPT("AEL",DFN,DGEL)) Q:'DGEL S DGALLEL=DGALLEL_$P($G(^DIC(8,DGEL,0)),U,9)_U
|
|---|
| 27 | F DGI=.3,.362,.52 S DGNODE(DGI)=$G(^DPT(DFN,DGI))
|
|---|
| 28 | I (DGALLEL["^1^") S $P(DGX,U,1)=1 G QTAUTO ;SC>50
|
|---|
| 29 | I $P(DGNODE(.362),U,12)["Y"!(DGALLEL["^2^") S $P(DGX,U,2)=1 G QTAUTO ;A&A
|
|---|
| 30 | I $P(DGNODE(.362),U,13)["Y"!(DGALLEL["^15^") S $P(DGX,U,3)=1 G QTAUTO ;HB
|
|---|
| 31 | I $P(DGNODE(.362),U,14)["Y"!(DGALLEL["^4^") S $P(DGX,U,4)=1 G QTAUTO ;PENSION
|
|---|
| 32 | I $P(DGNODE(.52),U,5)["Y"!(DGALLEL["^18^") S $P(DGX,U,8)=1 G QTAUTO ;POW
|
|---|
| 33 | 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
|
|---|
| 34 | N DGDOM,DGDOM1,VAHOW,VAROOT,VAINDT,VAIP,VAERR
|
|---|
| 35 | D DOM^DGMTR I $G(DGDOM) S $P(DGX,U,5)=1 G QTAUTO ;DOM
|
|---|
| 36 | D IN5^VADPT I $G(VAIP(1))'="" S $P(DGX,U,7)=1 G QTAUTO ;INPAT
|
|---|
| 37 | QTAUTO Q DGX
|
|---|
| 38 | ;
|
|---|
| 39 | LST(DFN,DGDT,DGMTYPT1) ;Last Copay Exemption or Means Test for a patient
|
|---|
| 40 | ; Input -- DFN Patient IEN
|
|---|
| 41 | ; DGDT Date/Time (Optional- default today@2359)
|
|---|
| 42 | ; DGMTYPT1 (Optional (1:MT, 2:CP, Null/Default or 3:Either)
|
|---|
| 43 | ; Output -- MT IEN^Date of Test ^Status Name^Status Code^Type of Test
|
|---|
| 44 | ; Piece: 1 ^ 2 3 4 5
|
|---|
| 45 | ;
|
|---|
| 46 | N DGCPDT,DGIDT,DGIDT,DGMTDT,DGMTI,Y
|
|---|
| 47 | S DGIDT=$S($G(DGDT)>0:-DGDT,1:-DT) S:'$P(DGIDT,".",2) DGIDT=DGIDT_.2359
|
|---|
| 48 | I '$D(DGMTYPT1) S DGMTYPT1=3
|
|---|
| 49 | I DGMTYPT1=3 D ;EITHER
|
|---|
| 50 | .S DGMTDT=+$O(^DGMT(408.31,"AID",1,DFN,DGIDT))
|
|---|
| 51 | .S DGCPDT=+$O(^DGMT(408.31,"AID",2,DFN,DGIDT))
|
|---|
| 52 | .S DGMTYPT1=$S(DGCPDT<DGMTDT:2,(DGCPDT>DGMTDT):1,$D(^DGMT(408.31,"AS",1,3,+DGMTDT,DFN)):2,1:1)
|
|---|
| 53 | S DGMTI=+$$LST^DGMTU(DFN,$P(DGIDT,"-",2),DGMTYPT1)
|
|---|
| 54 | I $D(^DGMT(408.31,DGMTI,0)) S Y=DGMTI_"^"_$P(^(0),"^")_"^"_$$MTS^DGMTU(DFN,+$P(^(0),"^",3))_"^"_DGMTYPT1
|
|---|
| 55 | Q $G(Y)
|
|---|
| 56 | THRESH(DGDT) ;PRINTS THE YEAR'S COPAY THRESHOLDS
|
|---|
| 57 | ;UPDATE 11/15/00 TO REFLECT YEAR'S COPAY THRESHOLDS PER VHA DIRECTIVE
|
|---|
| 58 | ;99-064
|
|---|
| 59 | N DGCPLEV,DGDEP,DGNODE,DGTYPE,Y
|
|---|
| 60 | I '$D(DGDT) S DGDT=DT
|
|---|
| 61 | S DGDT=DGDT\1
|
|---|
| 62 | S Y=DGDT X ^DD("DD") W !,?2,"Net Annual Income Thresholds on ",Y,":"
|
|---|
| 63 | S DGTYPE=$S(DGDT<2961201:2,1:1)
|
|---|
| 64 | S DGCPLEV=$$THRES^IBARXEU1(DGDT,DGTYPE,0)
|
|---|
| 65 | I DGCPLEV']"" W !,"None for this date..." G THRESHQT
|
|---|
| 66 | W !,?5,"Num. Dependents: ",?25,"0 (Self)",?42,1,?52,2,?62,3,?72,4
|
|---|
| 67 | W !,?5,"Net Income:"
|
|---|
| 68 | F DGDEP=0:1:4 W ?(23+(DGDEP*10)),$J(+$$THRES^IBARXEU1(DGDT,DGTYPE,DGDEP),10)
|
|---|
| 69 | THRESHQT Q
|
|---|
| 70 | DISPMAS(DFN) ; Displays Co
|
|---|
| 71 | N DGCPS,DGEX,Y,AUTOEX
|
|---|
| 72 | S DGEX=$$AUTO(DFN,.AUTOEX)
|
|---|
| 73 | I $P($G(AUTOEX),U,5)!($P($G(AUTOEX),U,7)) Q
|
|---|
| 74 | I DGEX W !,"Patient is exempt from Copay."
|
|---|
| 75 | I 'DGEX D
|
|---|
| 76 | .S DGCPS=$$LST365(DFN,DT,2),Y=$P(DGCPS,U,2)
|
|---|
| 77 | .I DGCPS]"" D
|
|---|
| 78 | ..X ^DD("DD")
|
|---|
| 79 | ..W !,"Patient's Copay Status is ",$P(DGCPS,U,3)
|
|---|
| 80 | ..W ". Last Test Date: ",Y,"."
|
|---|
| 81 | Q
|
|---|
| 82 | LST365(DFN,DGDT,DGMTYPT1) ;RETURNS CURRENT MT/CP (WITHIN 365 DAYS)
|
|---|
| 83 | ; Input: DGDT - IB DATE
|
|---|
| 84 | ; DGMTYPT1 (Optional (1:MT, 2:CP, Null/Default or 3:Either)
|
|---|
| 85 | ; Output -- MT IEN^Date of Test ^Status Name^Status Code^Type of Test
|
|---|
| 86 | ; Piece: 1 ^ 2 3 4 5
|
|---|
| 87 | N DGLST
|
|---|
| 88 | S DGDT=$G(DGDT)
|
|---|
| 89 | I '$D(DGMTYPT1) S DGMTYPT1=3
|
|---|
| 90 | S DGLST=$$LST(DFN,DGDT,DGMTYPT1)
|
|---|
| 91 | S:$P(DGLST,U,4)="N" DGLST=$$LST(DFN,DGDT,2)
|
|---|
| 92 | S:$$365($P(DGLST,U,2),DGDT) DGLST="" ;RETURN NULL IF LAST >365
|
|---|
| 93 | Q DGLST
|
|---|
| 94 | 365(X1,DGDT) ; RETURNS 1 IF X1 IS MORE THAN 1 YEAR BEFORE DGDT
|
|---|
| 95 | Q X1+10000'>DGDT
|
|---|
