DGBT1 ;ALB/SCK/BLD - BENEFICIARY TRAVEL DISPLAY SCREEN 1 ; 10/31/05
;;1.0;Beneficiary Travel;**11,20,24,30,39**;September 25, 2001;Build 6
Q
SCREEN ; clear screen and write headers
N TOTRIPS,ONEWAY,RT,MONTHDED,WAIVER,WTYPE,TTRIPS,TDED,TFIEN,DGBTOTHER
D MONTOT(.TOTRIPS,.ONEWAY,.RT,.MONTHDED,.WAIVER,.WTYPE,.TTRIPS,.TDED) Q:$G(DGBTQUIT)
S DGBTOTHER=0
W @IOF
W !?18,"Beneficiary Travel Claim Information <Screen 1>"
W !!?2,"Claim Date: ",DGBTDTE
D PID^VADPT6,RESADDR^DGBTUTL1(.DGBTADDR) W !!?8,"Name: ",VADM(1),?40,"PT ID: ",VA("PID"),?64,"DOB: ",$P(VADM(3),"^",2)
I '$G(CHZFLG)!('$D(^DGBT(392,DGBTDT,"D"))) D ;*39 - updated to use residential address
.W !!?5,"Address: ",DGBTADDR(1)
.W:DGBTADDR(2)]"" !?14,DGBTADDR(2)
.W:DGBTADDR(3)]"" !?14,DGBTADDR(3)
.W !?14,DGBTADDR(4),$S(DGBTADDR(4)]"":", "_$P(DGBTADDR(5),"^",2)_" "_$P(DGBTADDR(6),"^",2),1:"UNSPECIFIED")
I $G(CHZFLG),$D(^DGBT(392,DGBTDT,"D")) D
.N CLMADD,CLMST
.S CLMADD=^DGBT(392,DGBTDT,"D")
.S CLMST=$P(CLMADD,"^",5) S:$G(CLMST)'="" CLMST=$P(^DIC(5,CLMST,0),"^",2)
.W !!?5,"Address: ",$P(CLMADD,"^",1) W:$P(CLMADD,"^",2)]"" !?14,$P(CLMADD,"^",2) W:$P(CLMADD,"^",3)]"" !?14,$P(CLMADD,"^",3) W !?14,$P(CLMADD,"^",4),$S($P(CLMADD,"^",4)]"":", "_CLMST_" "_$P(CLMADD,"^",6),1:"UNSPECIFIED")
W !!?5,$$ADDCHG(DFN)
;
SETVAR ; if new claim, move in current info for elig, sc%
I 'CHZFLG S DGBTELG=VAEL(1),DGBTCSC=VAEL(3)
I +DGBTELG=3,'$E(DGBTCSC)=1 S DGBTCSC=1
I ($P(DGBTELG,U,2)["NSC")&(DGBTDYFL)&'($G(DGBTREF)) D
.I +$TR($P(DGBTINC,U),"$,","")<DGBTRXTH S $P(DGBTELG,U,2)=$P(DGBTELG,U,2)_" LOW INCOME"
W !!," Eligibility: ",$P(DGBTELG,"^",2) W:DGBTCSC ?45,"SC%: ",$P(DGBTCSC,"^",2) ;W !
I $O(VAEL(1,0))'="" W !," Other Elig.: " F I=0:0 S I=$O(VAEL(1,I)) Q:'I D
.W ?14,$P(VAEL(1,I),"^",2),!
.I VAEL(1,I)["HOUSEBOUND" S DGBTOTHER=1
.I VAEL(1,I)["AID & ATTENDANCE" S DGBTOTHER=1
.I VAEL(1,I)["PENSION" S DGBTOTHER=1
;
SC ; service connected status/information
I DGBTCSC&($P(DGBTCSC,"^",2)'>29) W !!,"Disabilities:" S I3=""
N DGQUIT
F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I!($G(DGQUIT)=1) D
. S I1=^(I,0),I2=$S($D(^DIC(31,+I1,0)):$P(^(0),"^",1)_" ("_+$P(I1,"^",2)_"%-"_$S($P(I1,"^",3):"SC",1:"NSC")_")",1:""),I3=I1
. I $Y>(IOSL-3) D PAUSE I DGQUIT=0 W @IOF
. I $G(DGQUIT)=1 Q
.D
..I DGBTCSC&($P(DGBTCSC,"^",2)'>29) Q
..I I=$O(^DPT(DFN,.372,0)) W !
. W ?16 W I2,!
;
INCOME ; income and eligibility information
;DAYFLG = NUMBER OF DAYS SINCE LAST MEANS TEST
N DGBTIFL,DGBTDATA,TESTDATE,DGBTDAYS,DGNOTEST,RXCP,RXCPST,DGRXDATA,RXDAYS,RXCPDATA,RXCPTS,DGBTST,BUSEXP,LOWINC,NOTEST
;
;
S DGBTIFL=$P(DGBTINC,U,2)
S (DAYFLG,RXDAYS,RXCPTS)=""
;CHECK HOW DAYS SINCE LAST MEANS TEST
I $$DAYSTEST(DFN,.DAYFLG,.RXDAYS,.RXCPST,.LOWINC,.DGNOTEST)
;
; added for patch *24 to check for VFA MT currency and reset DAYFLG as needed
I $$MTCHK^DGBTUTL1(DFN,$P(DGBTDT,".",1))>0 D
. S (DAYFLG,DGBTDYFL)=1
;
S BUSEXP=$$ABP^DGBTUTL(DFN)
;
;CHANGED FOR DGBT*1*20
S ELIGTYP=$$GET1^DIQ(8.1,3_",",.01)
I '$G(DGBTOTHER),'$G(LOWINC),($G(VAEL(3))),$P($G(VAEL(3)),"^",2)<30,($P(VAEL(1),"^",2))=ELIGTYP W !?2,"BT Alert: ELIGIBLE FOR SC APPOINTMENTS ONLY"
I $G(BUSEXP) D
.S Y=BUSEXP X ^DD("DD")
.W !!?2,"BT Alert: BUS PASS ISSUED - EXPIRES ",Y
;
I (DAYFLG!DGBTINCA),'$G(RXCPST) D D QUIT Q ;valid mt in last 365 days + PAVEL
.W !!?2,"Income: ",$P(DGBTINC,U),DGBTDTY,?35,"Source of Income: ",$S(DGBTIFL="M":"MEANS TEST",DGBTIFL="C":"COPAY TEST",DGBTIFL="P":"Alt.Income POW",DGBTIFL="H":"Alt. Income Hardship",1:"")
.W !?2,"No. of Dependents: ",DGBTDEP
.;
.I DGBTMTS]"" W:$P(DGBTMTS,"^")'="N" ?40,"MT Status: ",$S($P(DGBTMTS,"^")="R":"REQUIRED",$P(DGBTMTS,"^")="P":$P($P(DGBTMTS,"^",2)," "),DGBTMTS=U!($G(RXCPST)):" NOT APPLICABLE",1:$P(DGBTMTS,"^",2))
.W:$P(DGBTMTS,"^")="P" !?68,$P($P(DGBTMTS,"^",2)," ",2)
.I $P(DGBTMTS,"^")="N" W !!?20,"MEANS TEST ",$P(DGBTMTS,"^",2)
.;
.W !!?2,"BT Income: ",$S($D(DGBTCA):DGBTCA,1:"NOT RECORDED") W:$D(DGBTCE) ?25,"Certified Eligible: ",$S(DGBTCE:"YES",1:"NO"),?53,"Date Certified: ",$S($D(DGBTCD):DGBTCD,1:"NOT RECORDED")
.I $D(DGBTCE) I DGBTCE'=1 W *7,*7,!!?8,"* * * NOTE * * PATIENT HAS BEEN CERTIFIED INELIGIBLE BASED ON INCOME"
.S DGBTINFL="" I $D(DGBTINC),$D(DGBTCA),$P(DGBTINC,U)'=DGBTCA,$P(DGBTMTS,"^")'="N" S DGBTINFL=" * * * * Discrepancy exists in incomes reported, please verify * * * *" W !!?5,DGBTINFL
.I '$D(DGBTRET(0)) W !,?50,$$WVEXP ;*DGBT*1.0*20 BLD * E2
.I $D(DGBTRET(0)),$P(DGBTRET(0),"^",6)'="MAN" W !,?50,$$WVEXP ; /*DGBT*1.0*20 RFE */
.I $D(DGBTRET(0)),$P(DGBTRET(0),"^",6)="MAN" W !,?52,"WAIVER EXPIRES: ",$P(DGBTRET(0),"^",7)
.F I=$Y:1:20 W !
;
;no valid mt test in last 365 days or no test has been done
I 'DAYFLG D D QUIT Q
.W !!?2,"Income: ","",?40,"Source of Income: ",""
.W !?2,"No. of Dependents: ",DGBTDEP
.I DGBTMTS]"" W ?40,"MT Status: ","EXPIRED"
.W !!?2,"BT Income: ",$S($D(DGBTCA):DGBTCA,1:"NOT RECORDED") W:$D(DGBTCE) ?25,"Certified Eligible: ",$S(DGBTCE:"YES",1:"NO"),?53,"Date Certified: ",$S($D(DGBTCD):DGBTCD,1:"NOT RECORDED")
.I '$D(DGBTRET(0)) W !,?50,$$WVEXP ;*DGBT*1.0*20 BLD * E2
.I $D(DGBTRET(0)),$P(DGBTRET(0),"^",6)'="MAN" W !,?50,$$WVEXP ; /*DGBT*1.0*20 RFE */
.I $D(DGBTRET(0)),$P(DGBTRET(0),"^",6)="MAN" W !,?52,"WAIVER EXPIRES: ",$P(DGBTRET(0),"^",7)
.F I=$Y:1:20 W !
;
I DAYFLG,$G(RXCPST) D
.I $G(RXCP)'=1,$P($G(DGBTINCA),"^",2)'="" W !!?2,"Income: ",$S($P($G(DGBTINCA),"^",2)'="":$P(DGBTINCA,"^",2),1:""),DGBTDTY,?40,"Source of Income: ","Alternate Income/"_$S($P(DGBTINCA,"^",4)="H":"Hardship",1:"POW")
.I $G(RXCP)'=1,$P($G(DGBTINCA),"^",2)="" W !!?2,"Income: ",DGBTDTY,?40,"Source of Income: ","COPAY TEST" ;RXCP'=1 Copy NON-EXEMPT
.I $G(RXCP)=1,$P($G(DGBTINCA),"^",2)'="" W !!?2,"Income: ",$S($P($G(DGBTINCA),"^",2)'="":$P(DGBTINCA,"^",2),1:""),DGBTDTY,?40,"Source of Income: ","Alternate Income/"_$S($P(DGBTINCA,"^",4)="H":"Hardship",1:"POW")
.I $G(RXCP)=1,$P($G(DGBTINCA),"^",2)="" W !!?2,"Income: ",$P(DGBTINC,U),DGBTDTY,?40,"Source of Income: ","COPAY TEST" ;RXCP=1 Copay EXEMPT
.W !?2,"No. of Dependents: ",DGBTDEP
.I DGBTMTS]"" W ?40,"MT Status: ","NOT APPLICABLE"
.W !!?2,"BT Income: ","INELIGIBLE"
.I '$D(DGBTRET(0)) W ?50,$$WVEXP ;*DGBT*1.0*20 BLD * E2
.I $D(DGBTRET(0)),$P(DGBTRET(0),"^",6)'="MAN" W ?50,$$WVEXP ; /*DGBT*1.0*20 RFE */
.I $D(DGBTRET(0)),$P(DGBTRET(0),"^",6)="MAN" W ?52,"WAIVER EXPIRES: ",$P(DGBTRET(0),"^",7)
.F I=$Y:1:20 W !
;
QUIT ;
K I1,I2,I3
D MONTDISP(TOTRIPS,ONEWAY,RT,MONTHDED,WAIVER,WTYPE)
Q
;
MONTOT(TOTRIPS,ONEWAY,RT,MONTHDED,WAIVER,WTYPE,TTRIPS,TDED) ;
;
N RETURN
S RETURN=""
;Return values: total number of trips ^ number of one way trips ^ number of round trips ^ deductible (all this for the month) ^ waiver y/n (y will be 1, n will be no) ^
;total number of trips as of this claim date ^ deductible as of this claim date
;from the local data base
S RETURN=$$WAIV^DGBTRDVW(DFN,DGBTDTI)
S ONEWAY=$S($P($G(RETURN),"^",2):$P($G(RETURN),"^",2),1:0)
S RT=$S($P($G(RETURN),"^",3):$P($G(RETURN),"^",3),1:0)
S WAIVER=$S($P($G(RETURN),"^",5)=1:"YES",1:"NO")
S MONTHDED=$S($P($G(RETURN),"^",4):$P($G(RETURN),"^",4),1:0)
S WTYPE=$P(RETURN,"^",5)
S TOTRIPS=(RT*2)+ONEWAY
S TTRIPS=$S($P($G(RETURN),U,8):$P($G(RETURN),U,8),1:0)
S TDED=$S($P($G(RETURN),U,9):$P($G(RETURN),U,9),1:0)
S DGBTREF=0
S DGBTREF=$$LSTMTRIN(DFN,DGBTDTI)
I (WAIVER="NO")&($G(DGBTDYFL)) D
.I DGBTNSC D Q
..N INCOME
..S INCOME=+$TR($P($G(DGBTINC),U),"$,","")
..I INCOME'="",INCOME<DGBTRXTH,'$G(DGBTREF) S WAIVER="YES",$P(RETURN,U,5)=1,$P(RETURN,U,6)="NSC"
..;I ($P($G(DGBTINC),"^",1)'="")&+$TR($P(DGBTINC,U),"$,","")<DGBTRXTH,'$G(DGBTREF) S WAIVER="YES",$P(RETURN,U,5)=1,$P(RETURN,U,6)="NSC"
.I '$G(DGBTREF)&(+$G(VAEL(3)))&($P($G(DGBTINC),"^",1)'="")&(+$TR($P(DGBTINC,U),"$,","")<DGBTMTTH) S WAIVER="YES",$P(RETURN,U,5)=1,$P(RETURN,U,6)="LI" Q
.I ($P($G(DGBTINC),"^",1)'="")&+$$LI^DGBTUTL(DFN,DGBTDTI,DGBTDEP,,DGBTINCA)'=0 S WAIVER="YES",$P(RETURN,U,5)=1,$P(RETURN,U,6)="LI"
.I $P($G(DGBTINC),"^",1)="" S $P(RETURN,"^",6)=""
I TOTRIPS<6,MONTHDED<18,$P(RETURN,"^",5)=0 D Q:$G(DGBTQUIT) ;if less than 6 trips and no waiver check for remote facility visits
.S RETURN=""
.D OPT^DGBTRDV(DFN,DGBTDTI) I $G(RDVMSG) W $$PAUSE^DGBTUTL(0) S:$G(Y)="^" DGBTQUIT=1 Q:$G(DGBTQUIT)!($G(DGBTRET(0))="")
.I $G(RDVMSG) W $$PAUSE^DGBTUTL(0)
.S ONEWAY=$G(ONEWAY)+$P(RETURN,"^",2)
.S RT=$G(RT)+$P(RETURN,"^",3)
.S MONTHDED=$G(MONTHDED)+$P(RETURN,"^",4)
.S TOTRIPS=TOTRIPS+$P(RETURN,"^",1)
.S TTRIPS=TTRIPS+$P(RETURN,U,8)
.S TDED=TDED+$P(RETURN,U,9)
.S $P(RETURN,"^",1)=TOTRIPS
.S $P(RETURN,"^",8)=TTRIPS
.S $P(RETURN,"^",9)=TDED
.I $P(RETURN,"^",5)'=1 S $P(RETURN,"^",5)=$S(TTRIPS>6:1,TDED>18:0,1:$P(RETURN,"^",5))
.S WAIVER=$S($P(RETURN,"^",5)=1:"YES",1:"NO")
I WAIVER'="YES" S WAIVER=$S($P(RETURN,"^",1)>=6:"YES",1:"NO") ;*30 added greater than or equal to
S MONTOT=$G(TOTRIPS)_"^"_$G(ONEWAY)_"^"_$G(RT)_"^"_$G(MONTHDED)_"^"_$G(WAIVER)_U_$G(TTRIPS)_U_$G(TDED)
Q
;
MONTDISP(TOTRIPS,ONEWAY,RT,MONTHDED,WAIVER,WTYPE) ;
;
W !?2,"TOTAL TRIPS THIS MONTH: ",$G(ONEWAY)_" ONE WAY, ",$G(RT)_" RD TRIP"
W ?52,"WAIVER GRANTED: ",$G(WAIVER)
W !?2,"TOTAL DEDUCTIBLE THIS MONTH: ",MONTHDED
;
Q
;
PAUSE ;added with DGBT*1*11
I $E(IOST,1,2)["C-" N DIR S DIR(0)="E" D ^DIR S DGQUIT='Y
Q
;
DAYSTEST(DFN,DAYFLG,RXDAYS,RXCPST,LOWINC,NOTEST) ;determines whether or not a valid MT in last 365 days.
N DGBTDATA,TESTDATA,DGBTDAYS,DGMTSTAT,DGBTST,DGRXDATA,DGTSTTYP,DGMTST,X,DGMTYPT1,THRESHLD,INCOM
S DGMTYPT1=3,DAYFLG=0,(DGMTST,RXCPST,THRESHLD,INCOM)=""
S DGBTDATA=$$LST^DGMTCOU1(DFN,$P(DGBTDT,".",1),.DGMTYPT1)
I DGBTDATA'="" D
.S TESTDATE=$$LSTMTDT(DFN)
.S DGBTDAYS=$$FMDIFF^XLFDT($P(DGBTDTI,".",1),TESTDATE) ;get number of days from claim date to last MT
.S DAYFLG=$S(DGBTDAYS>365:0,1:1) ;if greater than 365 days then no valid MT test
.I DGMTYPT1=1 S DGMTST=$P(DGBTDATA,"^",3)="NO LONGER REQUIRED"
.I DGMTYPT1=2 S RXCPST=$P(DGBTDATA,"^",3)="NON-EXEMPT"
.S:RXCPST'=1 RXCP=1 ;************************
.S DGBTRET=$S(+$$LI^DGBTUTL(DFN,DGBTDTI,DGBTDEP,,DGBTINCA):"1^",1:"0^") ;Get Low Income + count Alternate Income PAVEL
.S LOWINC=$P(DGBTRET,"^",1)
I $G(DAYFLG)=0 S DGNOTEST=1
Q ""
;
ADDCHG(DFN) ;this will print the permanent Address last changed date or the Temporary Address last change date
;
N DATE,TMPADD
S TMPADD=$S($$GET1^DIQ(2,DFN,.12105)="YES":0,1:1)
I TMPADD D
.S DATE="Date Address Last Changed: "_$P($$GET1^DIQ(2,DFN,.118),"@",1)
E S DATE="Date Address Last Changed: "_$P($$GET1^DIQ(2,DFN,.12113),"@",1)
;
Q DATE
;
WVEXP() ; Waiver expiration date ; /* Tagline added DGBT*1.0*20 RFE */
N RETURN,VFADT,VFAMTDT,VFAMTDTP
I $$WVELG Q "WAIVER EXPIRES: PENSION"
N WVREQEXP
I $D(^DGBT(392.7,"C",DFN)) S WVREQEXP=$$WVREQ("IN")
I $G(WVREQEXP)="PENSION" Q "WAIVER EXPIRES: PENSION"
N DGMTYPT1,TESTDATEI
S TESTDATE=$$TESTDATE
S TESTDATEI=$$DTFORMI(TESTDATE)
I TESTDATEI<$P(DGBTDTI,".") Q ""
I +$G(DGBTINCA) Q "WAIVER EXPIRES: "_TESTDATE
I '+$G(LOWINC) Q $$WVREQ("EX")
N LABL
S LABL=$S($G(DGMTYPT1)=1:"MEANS TEST ",$G(DGMTYPT1)=2:"COPAY TEST ",1:"WAIVER ")_"EXPIRES: "
; ADDED FOR PATCH 24 VFA MT DO NOT EXPIRE
S VFADT=+$$GET1^DIQ(43,"1,",1205,"I",,"ERR")
S VFAMTDT=$P($$LST^DGMTCOU1(DFN,$P(DGBTDTI,"."),3),U,2),VFAMTDTP=$$FMADD^XLFDT(VFAMTDT,365,0,0,0)
I VFAMTDTP'<VFADT&(LABL["MEANS TEST") Q "MEANS TEST DO NOT EXPIRE"
;
Q LABL_TESTDATE
;
TESTDATE() ;
I (+$G(DGBTINCA)),($G(WVREQEXP)>$P(DGBTINCA,U,5)) Q $$DTFORM(WVREQEXP)
I +$G(DGBTINCA) Q $$DTFORM($P(DGBTINCA,U,5))
S DGMTYPT1=3
S TESTDATE=$P($$LST^DGMTCOU1(DFN,DGBTDTI,.DGMTYPT1),U,2)
I 'DAYFLG S (TESTDATE,DGMTYPT1)=0
I (+TESTDATE=0),($E($G(WVREQEXP),1,3)>$E(DGBTDTI,1,3)) Q $$DTFORM(WVREQEXP)
I +TESTDATE=0 Q "12/31/"_$E(DGBTDTI,2,3)
Q $$DTFORM(($E(TESTDATE,1,3)+1)_$E(TESTDATE,4,7))
;
DTFORM(INTDT) ;
Q $E(INTDT,4,5)_"/"_$E(INTDT,6,7)_"/"_$E(INTDT,2,3)
;
DTFORMI(TESTDATE) ;
Q 3_$P(TESTDATE,"/",3)_$P(TESTDATE,"/",2)_$P(TESTDATE,"/")
;
WVELG() ; Eligibility for waiver being PENSION DGBT*1.0*20 RFE
I VAEL(1)["PENSION" Q 1
I $P(VAEL(1),"^",2)="AID & ATTENDANCE" Q 1
I $P(VAEL(1),"^",2)="HOUSEBOUND" Q 1
N HIT
S (HIT,I)=""
F S I=$O(VAEL(1,I)) Q:I="" D Q:HIT
.I VAEL(1,I)["PENSION" S HIT=1 Q
.I $P(VAEL(3),U,2)'=100 D ;*30 added to prevent waiver for 100% SC
..I $P(VAEL(1,I),"^",2)="AID & ATTENDANCE" S HIT=1 Q
..I $P(VAEL(1,I),"^",2)="HOUSEBOUND" S HIT=1 Q
Q HIT
;
YEAR(DT1) ; DT2 will be a year after DT1 ; /*Tagline added DGBT*1.0*20 RFE */
N DT2,MO,YR
S DT2=$$FMTH^XLFDT(DT1,1)+365
S YR=+$E(DT1,2,3),MO=+$E(DT1,4,5)
I (YR#4=3),(MO>2) S DT2=DT2+1 ; Leap year
I (YR#4=0),(MO<3) S DT2=DT2+1 ; Leap year
Q DT2
;
WVREQ(INEX) ; Manual deductible waiver request DGBT*1.0*20 RFE
I '$D(^DGBT(392.7,"C",DFN)) Q ""
N DGBTDW,EXPDT
S (DGBTDW,I)=""
F S I=$O(^DGBT(392.7,"C",DFN,I),-1) Q:I="" D Q:DGBTDW'=""
.I $$GET1^DIQ(392.7,I,97,"I") Q
. S EXPDT=$$GET1^DIQ(392.7,I,8,"I")
. I EXPDT="PENSION" S DGBTDW=1 Q
. I $E(I,1,3)=$E(DGBTA,1,3) S DGBTDW=^DGBT(392.7,I,0) Q
. I $E(I,1,3)'=($E(DGBTA,1,3)-1) Q
. I $$GET1^DIQ(392.7,I,8,"I")<$P(DGBTA,".") Q
. S DGBTDW=^DGBT(392.7,I,0)
I DGBTDW="" Q ""
I $P(DGBTDW,"^",3)=0 Q ""
I $P(DGBTA,".")<$P($P(DGBTDW,U),".") Q ""
I INEX="IN" Q EXPDT
I $G(EXPDT)="PENSION" Q "WAIVER EXPIRES: PENSION"
I EXPDT<$P(DGBTDTI,".") Q ""
Q "WAIVER EXPIRES: "_$$DTFORM(EXPDT)
;
LSTMTDT(DFN) ;this will return the last means test date
N MTIEN
S MTIEN=""
S MTIEN=$O(^DGMT(408.31,"C",DFN,MTIEN),-1)
S LSTMTDT=$P(^DGMT(408.31,MTIEN,0),"^",1)
Q LSTMTDT
;
LSTMTRIN(DFN,DGBTDTI) ;this will return whether the patient refused to give income
N MTIEN,REFUSED
S REFUSED=1
S MTIEN=+$$LST^DGMTCOU1(DFN,DGBTDTI,3)
I MTIEN'="" S REFUSED=$$GET1^DIQ(408.31,MTIEN,.14,"I")
Q REFUSED
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBT1 14076 printed Sep 23, 2025@19:16:07 Page 2
DGBT1 ;ALB/SCK/BLD - BENEFICIARY TRAVEL DISPLAY SCREEN 1 ; 10/31/05
+1 ;;1.0;Beneficiary Travel;**11,20,24,30,39**;September 25, 2001;Build 6
+2 QUIT
SCREEN ; clear screen and write headers
+1 NEW TOTRIPS,ONEWAY,RT,MONTHDED,WAIVER,WTYPE,TTRIPS,TDED,TFIEN,DGBTOTHER
+2 DO MONTOT(.TOTRIPS,.ONEWAY,.RT,.MONTHDED,.WAIVER,.WTYPE,.TTRIPS,.TDED)
if $GET(DGBTQUIT)
QUIT
+3 SET DGBTOTHER=0
+4 WRITE @IOF
+5 WRITE !?18,"Beneficiary Travel Claim Information <Screen 1>"
+6 WRITE !!?2,"Claim Date: ",DGBTDTE
+7 DO PID^VADPT6
DO RESADDR^DGBTUTL1(.DGBTADDR)
WRITE !!?8,"Name: ",VADM(1),?40,"PT ID: ",VA("PID"),?64,"DOB: ",$PIECE(VADM(3),"^",2)
+8 ;*39 - updated to use residential address
IF '$GET(CHZFLG)!('$DATA(^DGBT(392,DGBTDT,"D")))
Begin DoDot:1
+9 WRITE !!?5,"Address: ",DGBTADDR(1)
+10 if DGBTADDR(2)]""
WRITE !?14,DGBTADDR(2)
+11 if DGBTADDR(3)]""
WRITE !?14,DGBTADDR(3)
+12 WRITE !?14,DGBTADDR(4),$SELECT(DGBTADDR(4)]"":", "_$PIECE(DGBTADDR(5),"^",2)_" "_$PIECE(DGBTADDR(6),"^",2),1:"UNSPECIFIED")
End DoDot:1
+13 IF $GET(CHZFLG)
IF $DATA(^DGBT(392,DGBTDT,"D"))
Begin DoDot:1
+14 NEW CLMADD,CLMST
+15 SET CLMADD=^DGBT(392,DGBTDT,"D")
+16 SET CLMST=$PIECE(CLMADD,"^",5)
if $GET(CLMST)'=""
SET CLMST=$PIECE(^DIC(5,CLMST,0),"^",2)
+17 WRITE !!?5,"Address: ",$PIECE(CLMADD,"^",1)
if $PIECE(CLMADD,"^",2)]""
WRITE !?14,$PIECE(CLMADD,"^",2)
if $PIECE(CLMADD,"^",3)]""
WRITE !?14,$PIECE(CLMADD,"^",3)
WRITE !?14,$PIECE(CLMADD,"^",4),$SELECT($PIECE(CLMADD,"^",4)]"":", "_CLMST_" "_$PIECE(CLMADD,"^",6),1:"UNSPECIFIED")
End DoDot:1
+18 WRITE !!?5,$$ADDCHG(DFN)
+19 ;
SETVAR ; if new claim, move in current info for elig, sc%
+1 IF 'CHZFLG
SET DGBTELG=VAEL(1)
SET DGBTCSC=VAEL(3)
+2 IF +DGBTELG=3
IF '$EXTRACT(DGBTCSC)=1
SET DGBTCSC=1
+3 IF ($PIECE(DGBTELG,U,2)["NSC")&(DGBTDYFL)&'($GET(DGBTREF))
Begin DoDot:1
+4 IF +$TRANSLATE($PIECE(DGBTINC,U),"$,","")<DGBTRXTH
SET $PIECE(DGBTELG,U,2)=$PIECE(DGBTELG,U,2)_" LOW INCOME"
End DoDot:1
+5 ;W !
WRITE !!," Eligibility: ",$PIECE(DGBTELG,"^",2)
if DGBTCSC
WRITE ?45,"SC%: ",$PIECE(DGBTCSC,"^",2)
+6 IF $ORDER(VAEL(1,0))'=""
WRITE !," Other Elig.: "
FOR I=0:0
SET I=$ORDER(VAEL(1,I))
if 'I
QUIT
Begin DoDot:1
+7 WRITE ?14,$PIECE(VAEL(1,I),"^",2),!
+8 IF VAEL(1,I)["HOUSEBOUND"
SET DGBTOTHER=1
+9 IF VAEL(1,I)["AID & ATTENDANCE"
SET DGBTOTHER=1
+10 IF VAEL(1,I)["PENSION"
SET DGBTOTHER=1
End DoDot:1
+11 ;
SC ; service connected status/information
+1 IF DGBTCSC&($PIECE(DGBTCSC,"^",2)'>29)
WRITE !!,"Disabilities:"
SET I3=""
+2 NEW DGQUIT
+3 FOR I=0:0
SET I=$ORDER(^DPT(DFN,.372,I))
if 'I!($GET(DGQUIT)=1)
QUIT
Begin DoDot:1
+4 SET I1=^(I,0)
SET I2=$SELECT($DATA(^DIC(31,+I1,0)):$PIECE(^(0),"^",1)_" ("_+$PIECE(I1,"^",2)_"%-"_$SELECT($PIECE(I1,"^",3):"SC",1:"NSC")_")",1:"")
SET I3=I1
+5 IF $Y>(IOSL-3)
DO PAUSE
IF DGQUIT=0
WRITE @IOF
+6 IF $GET(DGQUIT)=1
QUIT
+7 Begin DoDot:2
+8 IF DGBTCSC&($PIECE(DGBTCSC,"^",2)'>29)
QUIT
+9 IF I=$ORDER(^DPT(DFN,.372,0))
WRITE !
End DoDot:2
+10 WRITE ?16
WRITE I2,!
End DoDot:1
+11 ;
INCOME ; income and eligibility information
+1 ;DAYFLG = NUMBER OF DAYS SINCE LAST MEANS TEST
+2 NEW DGBTIFL,DGBTDATA,TESTDATE,DGBTDAYS,DGNOTEST,RXCP,RXCPST,DGRXDATA,RXDAYS,RXCPDATA,RXCPTS,DGBTST,BUSEXP,LOWINC,NOTEST
+3 ;
+4 ;
+5 SET DGBTIFL=$PIECE(DGBTINC,U,2)
+6 SET (DAYFLG,RXDAYS,RXCPTS)=""
+7 ;CHECK HOW DAYS SINCE LAST MEANS TEST
+8 IF $$DAYSTEST(DFN,.DAYFLG,.RXDAYS,.RXCPST,.LOWINC,.DGNOTEST)
+9 ;
+10 ; added for patch *24 to check for VFA MT currency and reset DAYFLG as needed
+11 IF $$MTCHK^DGBTUTL1(DFN,$PIECE(DGBTDT,".",1))>0
Begin DoDot:1
+12 SET (DAYFLG,DGBTDYFL)=1
End DoDot:1
+13 ;
+14 SET BUSEXP=$$ABP^DGBTUTL(DFN)
+15 ;
+16 ;CHANGED FOR DGBT*1*20
+17 SET ELIGTYP=$$GET1^DIQ(8.1,3_",",.01)
+18 IF '$GET(DGBTOTHER)
IF '$GET(LOWINC)
IF ($GET(VAEL(3)))
IF $PIECE($GET(VAEL(3)),"^",2)<30
IF ($PIECE(VAEL(1),"^",2))=ELIGTYP
WRITE !?2,"BT Alert: ELIGIBLE FOR SC APPOINTMENTS ONLY"
+19 IF $GET(BUSEXP)
Begin DoDot:1
+20 SET Y=BUSEXP
XECUTE ^DD("DD")
+21 WRITE !!?2,"BT Alert: BUS PASS ISSUED - EXPIRES ",Y
End DoDot:1
+22 ;
+23 ;valid mt in last 365 days + PAVEL
IF (DAYFLG!DGBTINCA)
IF '$GET(RXCPST)
Begin DoDot:1
+24 WRITE !!?2,"Income: ",$PIECE(DGBTINC,U),DGBTDTY,?35,"Source of Income: ",$SELECT(DGBTIFL="M":"MEANS TEST",DGBTIFL="C":"COPAY TEST",DGBTIFL="P":"Alt.Income POW",DGBTIFL="H":"Alt. Income Hardship",1:"")
+25 WRITE !?2,"No. of Dependents: ",DGBTDEP
+26 ;
+27 IF DGBTMTS]""
if $PIECE(DGBTMTS,"^")'="N"
WRITE ?40,"MT Status: ",$SELECT($PIECE(DGBTMTS,"^")="R":"REQUIRED",$PIECE(DGBTMTS,"^")="P":$PIECE($PIECE(DGBTMTS,"^",2)," "),DGBTMTS=U!($GET(RXCPST)):" NOT APPLICABLE",1:$PIECE(DGBTMTS,"^",2))
+28 if $PIECE(DGBTMTS,"^")="P"
WRITE !?68,$PIECE($PIECE(DGBTMTS,"^",2)," ",2)
+29 IF $PIECE(DGBTMTS,"^")="N"
WRITE !!?20,"MEANS TEST ",$PIECE(DGBTMTS,"^",2)
+30 ;
+31 WRITE !!?2,"BT Income: ",$SELECT($DATA(DGBTCA):DGBTCA,1:"NOT RECORDED")
if $DATA(DGBTCE)
WRITE ?25,"Certified Eligible: ",$SELECT(DGBTCE:"YES",1:"NO"),?53,"Date Certified: ",$SELECT($DATA(DGBTCD):DGBTCD,1:"NOT RECORDED")
+32 IF $DATA(DGBTCE)
IF DGBTCE'=1
WRITE *7,*7,!!?8,"* * * NOTE * * PATIENT HAS BEEN CERTIFIED INELIGIBLE BASED ON INCOME"
+33 SET DGBTINFL=""
IF $DATA(DGBTINC)
IF $DATA(DGBTCA)
IF $PIECE(DGBTINC,U)'=DGBTCA
IF $PIECE(DGBTMTS,"^")'="N"
SET DGBTINFL=" * * * * Discrepancy exists in incomes reported, please verify * * * *"
WRITE !!?5,DGBTINFL
+34 ;*DGBT*1.0*20 BLD * E2
IF '$DATA(DGBTRET(0))
WRITE !,?50,$$WVEXP
+35 ; /*DGBT*1.0*20 RFE */
IF $DATA(DGBTRET(0))
IF $PIECE(DGBTRET(0),"^",6)'="MAN"
WRITE !,?50,$$WVEXP
+36 IF $DATA(DGBTRET(0))
IF $PIECE(DGBTRET(0),"^",6)="MAN"
WRITE !,?52,"WAIVER EXPIRES: ",$PIECE(DGBTRET(0),"^",7)
+37 FOR I=$Y:1:20
WRITE !
End DoDot:1
DO QUIT
QUIT
+38 ;
+39 ;no valid mt test in last 365 days or no test has been done
+40 IF 'DAYFLG
Begin DoDot:1
+41 WRITE !!?2,"Income: ","",?40,"Source of Income: ",""
+42 WRITE !?2,"No. of Dependents: ",DGBTDEP
+43 IF DGBTMTS]""
WRITE ?40,"MT Status: ","EXPIRED"
+44 WRITE !!?2,"BT Income: ",$SELECT($DATA(DGBTCA):DGBTCA,1:"NOT RECORDED")
if $DATA(DGBTCE)
WRITE ?25,"Certified Eligible: ",$SELECT(DGBTCE:"YES",1:"NO"),?53,"Date Certified: ",$SELECT($DATA(DGBTCD):DGBTCD,1:"NOT RECORDED")
+45 ;*DGBT*1.0*20 BLD * E2
IF '$DATA(DGBTRET(0))
WRITE !,?50,$$WVEXP
+46 ; /*DGBT*1.0*20 RFE */
IF $DATA(DGBTRET(0))
IF $PIECE(DGBTRET(0),"^",6)'="MAN"
WRITE !,?50,$$WVEXP
+47 IF $DATA(DGBTRET(0))
IF $PIECE(DGBTRET(0),"^",6)="MAN"
WRITE !,?52,"WAIVER EXPIRES: ",$PIECE(DGBTRET(0),"^",7)
+48 FOR I=$Y:1:20
WRITE !
End DoDot:1
DO QUIT
QUIT
+49 ;
+50 IF DAYFLG
IF $GET(RXCPST)
Begin DoDot:1
+51 IF $GET(RXCP)'=1
IF $PIECE($GET(DGBTINCA),"^",2)'=""
WRITE !!?2,"Income: ",$SELECT($PIECE($GET(DGBTINCA),"^",2)'="":$PIECE(DGBTINCA,"^",2),1:""),DGBTDTY,?40,"Source of Income: ","Alternate Income/"_$SELECT($PIECE(DGBTINCA,"^",4)="H":"Hardship",1:"POW")
+52 ;RXCP'=1 Copy NON-EXEMPT
IF $GET(RXCP)'=1
IF $PIECE($GET(DGBTINCA),"^",2)=""
WRITE !!?2,"Income: ",DGBTDTY,?40,"Source of Income: ","COPAY TEST"
+53 IF $GET(RXCP)=1
IF $PIECE($GET(DGBTINCA),"^",2)'=""
WRITE !!?2,"Income: ",$SELECT($PIECE($GET(DGBTINCA),"^",2)'="":$PIECE(DGBTINCA,"^",2),1:""),DGBTDTY,?40,"Source of Income: ","Alternate Income/"_$SELECT($PIECE(DGBTINCA,"^",4)="H":"Hardship",1:"POW")
+54 ;RXCP=1 Copay EXEMPT
IF $GET(RXCP)=1
IF $PIECE($GET(DGBTINCA),"^",2)=""
WRITE !!?2,"Income: ",$PIECE(DGBTINC,U),DGBTDTY,?40,"Source of Income: ","COPAY TEST"
+55 WRITE !?2,"No. of Dependents: ",DGBTDEP
+56 IF DGBTMTS]""
WRITE ?40,"MT Status: ","NOT APPLICABLE"
+57 WRITE !!?2,"BT Income: ","INELIGIBLE"
+58 ;*DGBT*1.0*20 BLD * E2
IF '$DATA(DGBTRET(0))
WRITE ?50,$$WVEXP
+59 ; /*DGBT*1.0*20 RFE */
IF $DATA(DGBTRET(0))
IF $PIECE(DGBTRET(0),"^",6)'="MAN"
WRITE ?50,$$WVEXP
+60 IF $DATA(DGBTRET(0))
IF $PIECE(DGBTRET(0),"^",6)="MAN"
WRITE ?52,"WAIVER EXPIRES: ",$PIECE(DGBTRET(0),"^",7)
+61 FOR I=$Y:1:20
WRITE !
End DoDot:1
+62 ;
QUIT ;
+1 KILL I1,I2,I3
+2 DO MONTDISP(TOTRIPS,ONEWAY,RT,MONTHDED,WAIVER,WTYPE)
+3 QUIT
+4 ;
MONTOT(TOTRIPS,ONEWAY,RT,MONTHDED,WAIVER,WTYPE,TTRIPS,TDED) ;
+1 ;
+2 NEW RETURN
+3 SET RETURN=""
+4 ;Return values: total number of trips ^ number of one way trips ^ number of round trips ^ deductible (all this for the month) ^ waiver y/n (y will be 1, n will be no) ^
+5 ;total number of trips as of this claim date ^ deductible as of this claim date
+6 ;from the local data base
+7 SET RETURN=$$WAIV^DGBTRDVW(DFN,DGBTDTI)
+8 SET ONEWAY=$SELECT($PIECE($GET(RETURN),"^",2):$PIECE($GET(RETURN),"^",2),1:0)
+9 SET RT=$SELECT($PIECE($GET(RETURN),"^",3):$PIECE($GET(RETURN),"^",3),1:0)
+10 SET WAIVER=$SELECT($PIECE($GET(RETURN),"^",5)=1:"YES",1:"NO")
+11 SET MONTHDED=$SELECT($PIECE($GET(RETURN),"^",4):$PIECE($GET(RETURN),"^",4),1:0)
+12 SET WTYPE=$PIECE(RETURN,"^",5)
+13 SET TOTRIPS=(RT*2)+ONEWAY
+14 SET TTRIPS=$SELECT($PIECE($GET(RETURN),U,8):$PIECE($GET(RETURN),U,8),1:0)
+15 SET TDED=$SELECT($PIECE($GET(RETURN),U,9):$PIECE($GET(RETURN),U,9),1:0)
+16 SET DGBTREF=0
+17 SET DGBTREF=$$LSTMTRIN(DFN,DGBTDTI)
+18 IF (WAIVER="NO")&($GET(DGBTDYFL))
Begin DoDot:1
+19 IF DGBTNSC
Begin DoDot:2
+20 NEW INCOME
+21 SET INCOME=+$TRANSLATE($PIECE($GET(DGBTINC),U),"$,","")
+22 IF INCOME'=""
IF INCOME<DGBTRXTH
IF '$GET(DGBTREF)
SET WAIVER="YES"
SET $PIECE(RETURN,U,5)=1
SET $PIECE(RETURN,U,6)="NSC"
+23 ;I ($P($G(DGBTINC),"^",1)'="")&+$TR($P(DGBTINC,U),"$,","")<DGBTRXTH,'$G(DGBTREF) S WAIVER="YES",$P(RETURN,U,5)=1,$P(RETURN,U,6)="NSC"
End DoDot:2
QUIT
+24 IF '$GET(DGBTREF)&(+$GET(VAEL(3)))&($PIECE($GET(DGBTINC),"^",1)'="")&(+$TRANSLATE($PIECE(DGBTINC,U),"$,","")<DGBTMTTH)
SET WAIVER="YES"
SET $PIECE(RETURN,U,5)=1
SET $PIECE(RETURN,U,6)="LI"
QUIT
+25 IF ($PIECE($GET(DGBTINC),"^",1)'="")&+$$LI^DGBTUTL(DFN,DGBTDTI,DGBTDEP,,DGBTINCA)'=0
SET WAIVER="YES"
SET $PIECE(RETURN,U,5)=1
SET $PIECE(RETURN,U,6)="LI"
+26 IF $PIECE($GET(DGBTINC),"^",1)=""
SET $PIECE(RETURN,"^",6)=""
End DoDot:1
+27 ;if less than 6 trips and no waiver check for remote facility visits
IF TOTRIPS<6
IF MONTHDED<18
IF $PIECE(RETURN,"^",5)=0
Begin DoDot:1
+28 SET RETURN=""
+29 DO OPT^DGBTRDV(DFN,DGBTDTI)
IF $GET(RDVMSG)
WRITE $$PAUSE^DGBTUTL(0)
if $GET(Y)="^"
SET DGBTQUIT=1
if $GET(DGBTQUIT)!($GET(DGBTRET(0))="")
QUIT
+30 IF $GET(RDVMSG)
WRITE $$PAUSE^DGBTUTL(0)
+31 SET ONEWAY=$GET(ONEWAY)+$PIECE(RETURN,"^",2)
+32 SET RT=$GET(RT)+$PIECE(RETURN,"^",3)
+33 SET MONTHDED=$GET(MONTHDED)+$PIECE(RETURN,"^",4)
+34 SET TOTRIPS=TOTRIPS+$PIECE(RETURN,"^",1)
+35 SET TTRIPS=TTRIPS+$PIECE(RETURN,U,8)
+36 SET TDED=TDED+$PIECE(RETURN,U,9)
+37 SET $PIECE(RETURN,"^",1)=TOTRIPS
+38 SET $PIECE(RETURN,"^",8)=TTRIPS
+39 SET $PIECE(RETURN,"^",9)=TDED
+40 IF $PIECE(RETURN,"^",5)'=1
SET $PIECE(RETURN,"^",5)=$SELECT(TTRIPS>6:1,TDED>18:0,1:$PIECE(RETURN,"^",5))
+41 SET WAIVER=$SELECT($PIECE(RETURN,"^",5)=1:"YES",1:"NO")
End DoDot:1
if $GET(DGBTQUIT)
QUIT
+42 ;*30 added greater than or equal to
IF WAIVER'="YES"
SET WAIVER=$SELECT($PIECE(RETURN,"^",1)>=6:"YES",1:"NO")
+43 SET MONTOT=$GET(TOTRIPS)_"^"_$GET(ONEWAY)_"^"_$GET(RT)_"^"_$GET(MONTHDED)_"^"_$GET(WAIVER)_U_$GET(TTRIPS)_U_$GET(TDED)
+44 QUIT
+45 ;
MONTDISP(TOTRIPS,ONEWAY,RT,MONTHDED,WAIVER,WTYPE) ;
+1 ;
+2 WRITE !?2,"TOTAL TRIPS THIS MONTH: ",$GET(ONEWAY)_" ONE WAY, ",$GET(RT)_" RD TRIP"
+3 WRITE ?52,"WAIVER GRANTED: ",$GET(WAIVER)
+4 WRITE !?2,"TOTAL DEDUCTIBLE THIS MONTH: ",MONTHDED
+5 ;
+6 QUIT
+7 ;
PAUSE ;added with DGBT*1*11
+1 IF $EXTRACT(IOST,1,2)["C-"
NEW DIR
SET DIR(0)="E"
DO ^DIR
SET DGQUIT='Y
+2 QUIT
+3 ;
DAYSTEST(DFN,DAYFLG,RXDAYS,RXCPST,LOWINC,NOTEST) ;determines whether or not a valid MT in last 365 days.
+1 NEW DGBTDATA,TESTDATA,DGBTDAYS,DGMTSTAT,DGBTST,DGRXDATA,DGTSTTYP,DGMTST,X,DGMTYPT1,THRESHLD,INCOM
+2 SET DGMTYPT1=3
SET DAYFLG=0
SET (DGMTST,RXCPST,THRESHLD,INCOM)=""
+3 SET DGBTDATA=$$LST^DGMTCOU1(DFN,$PIECE(DGBTDT,".",1),.DGMTYPT1)
+4 IF DGBTDATA'=""
Begin DoDot:1
+5 SET TESTDATE=$$LSTMTDT(DFN)
+6 ;get number of days from claim date to last MT
SET DGBTDAYS=$$FMDIFF^XLFDT($PIECE(DGBTDTI,".",1),TESTDATE)
+7 ;if greater than 365 days then no valid MT test
SET DAYFLG=$SELECT(DGBTDAYS>365:0,1:1)
+8 IF DGMTYPT1=1
SET DGMTST=$PIECE(DGBTDATA,"^",3)="NO LONGER REQUIRED"
+9 IF DGMTYPT1=2
SET RXCPST=$PIECE(DGBTDATA,"^",3)="NON-EXEMPT"
+10 ;************************
if RXCPST'=1
SET RXCP=1
+11 ;Get Low Income + count Alternate Income PAVEL
SET DGBTRET=$SELECT(+$$LI^DGBTUTL(DFN,DGBTDTI,DGBTDEP,,DGBTINCA):"1^",1:"0^")
+12 SET LOWINC=$PIECE(DGBTRET,"^",1)
End DoDot:1
+13 IF $GET(DAYFLG)=0
SET DGNOTEST=1
+14 QUIT ""
+15 ;
ADDCHG(DFN) ;this will print the permanent Address last changed date or the Temporary Address last change date
+1 ;
+2 NEW DATE,TMPADD
+3 SET TMPADD=$SELECT($$GET1^DIQ(2,DFN,.12105)="YES":0,1:1)
+4 IF TMPADD
Begin DoDot:1
+5 SET DATE="Date Address Last Changed: "_$PIECE($$GET1^DIQ(2,DFN,.118),"@",1)
End DoDot:1
+6 IF '$TEST
SET DATE="Date Address Last Changed: "_$PIECE($$GET1^DIQ(2,DFN,.12113),"@",1)
+7 ;
+8 QUIT DATE
+9 ;
WVEXP() ; Waiver expiration date ; /* Tagline added DGBT*1.0*20 RFE */
+1 NEW RETURN,VFADT,VFAMTDT,VFAMTDTP
+2 IF $$WVELG
QUIT "WAIVER EXPIRES: PENSION"
+3 NEW WVREQEXP
+4 IF $DATA(^DGBT(392.7,"C",DFN))
SET WVREQEXP=$$WVREQ("IN")
+5 IF $GET(WVREQEXP)="PENSION"
QUIT "WAIVER EXPIRES: PENSION"
+6 NEW DGMTYPT1,TESTDATEI
+7 SET TESTDATE=$$TESTDATE
+8 SET TESTDATEI=$$DTFORMI(TESTDATE)
+9 IF TESTDATEI<$PIECE(DGBTDTI,".")
QUIT ""
+10 IF +$GET(DGBTINCA)
QUIT "WAIVER EXPIRES: "_TESTDATE
+11 IF '+$GET(LOWINC)
QUIT $$WVREQ("EX")
+12 NEW LABL
+13 SET LABL=$SELECT($GET(DGMTYPT1)=1:"MEANS TEST ",$GET(DGMTYPT1)=2:"COPAY TEST ",1:"WAIVER ")_"EXPIRES: "
+14 ; ADDED FOR PATCH 24 VFA MT DO NOT EXPIRE
+15 SET VFADT=+$$GET1^DIQ(43,"1,",1205,"I",,"ERR")
+16 SET VFAMTDT=$PIECE($$LST^DGMTCOU1(DFN,$PIECE(DGBTDTI,"."),3),U,2)
SET VFAMTDTP=$$FMADD^XLFDT(VFAMTDT,365,0,0,0)
+17 IF VFAMTDTP'<VFADT&(LABL["MEANS TEST")
QUIT "MEANS TEST DO NOT EXPIRE"
+18 ;
+19 QUIT LABL_TESTDATE
+20 ;
TESTDATE() ;
+1 IF (+$GET(DGBTINCA))
IF ($GET(WVREQEXP)>$PIECE(DGBTINCA,U,5))
QUIT $$DTFORM(WVREQEXP)
+2 IF +$GET(DGBTINCA)
QUIT $$DTFORM($PIECE(DGBTINCA,U,5))
+3 SET DGMTYPT1=3
+4 SET TESTDATE=$PIECE($$LST^DGMTCOU1(DFN,DGBTDTI,.DGMTYPT1),U,2)
+5 IF 'DAYFLG
SET (TESTDATE,DGMTYPT1)=0
+6 IF (+TESTDATE=0)
IF ($EXTRACT($GET(WVREQEXP),1,3)>$EXTRACT(DGBTDTI,1,3))
QUIT $$DTFORM(WVREQEXP)
+7 IF +TESTDATE=0
QUIT "12/31/"_$EXTRACT(DGBTDTI,2,3)
+8 QUIT $$DTFORM(($EXTRACT(TESTDATE,1,3)+1)_$EXTRACT(TESTDATE,4,7))
+9 ;
DTFORM(INTDT) ;
+1 QUIT $EXTRACT(INTDT,4,5)_"/"_$EXTRACT(INTDT,6,7)_"/"_$EXTRACT(INTDT,2,3)
+2 ;
DTFORMI(TESTDATE) ;
+1 QUIT 3_$PIECE(TESTDATE,"/",3)_$PIECE(TESTDATE,"/",2)_$PIECE(TESTDATE,"/")
+2 ;
WVELG() ; Eligibility for waiver being PENSION DGBT*1.0*20 RFE
+1 IF VAEL(1)["PENSION"
QUIT 1
+2 IF $PIECE(VAEL(1),"^",2)="AID & ATTENDANCE"
QUIT 1
+3 IF $PIECE(VAEL(1),"^",2)="HOUSEBOUND"
QUIT 1
+4 NEW HIT
+5 SET (HIT,I)=""
+6 FOR
SET I=$ORDER(VAEL(1,I))
if I=""
QUIT
Begin DoDot:1
+7 IF VAEL(1,I)["PENSION"
SET HIT=1
QUIT
+8 ;*30 added to prevent waiver for 100% SC
IF $PIECE(VAEL(3),U,2)'=100
Begin DoDot:2
+9 IF $PIECE(VAEL(1,I),"^",2)="AID & ATTENDANCE"
SET HIT=1
QUIT
+10 IF $PIECE(VAEL(1,I),"^",2)="HOUSEBOUND"
SET HIT=1
QUIT
End DoDot:2
End DoDot:1
if HIT
QUIT
+11 QUIT HIT
+12 ;
YEAR(DT1) ; DT2 will be a year after DT1 ; /*Tagline added DGBT*1.0*20 RFE */
+1 NEW DT2,MO,YR
+2 SET DT2=$$FMTH^XLFDT(DT1,1)+365
+3 SET YR=+$EXTRACT(DT1,2,3)
SET MO=+$EXTRACT(DT1,4,5)
+4 ; Leap year
IF (YR#4=3)
IF (MO>2)
SET DT2=DT2+1
+5 ; Leap year
IF (YR#4=0)
IF (MO<3)
SET DT2=DT2+1
+6 QUIT DT2
+7 ;
WVREQ(INEX) ; Manual deductible waiver request DGBT*1.0*20 RFE
+1 IF '$DATA(^DGBT(392.7,"C",DFN))
QUIT ""
+2 NEW DGBTDW,EXPDT
+3 SET (DGBTDW,I)=""
+4 FOR
SET I=$ORDER(^DGBT(392.7,"C",DFN,I),-1)
if I=""
QUIT
Begin DoDot:1
+5 IF $$GET1^DIQ(392.7,I,97,"I")
QUIT
+6 SET EXPDT=$$GET1^DIQ(392.7,I,8,"I")
+7 IF EXPDT="PENSION"
SET DGBTDW=1
QUIT
+8 IF $EXTRACT(I,1,3)=$EXTRACT(DGBTA,1,3)
SET DGBTDW=^DGBT(392.7,I,0)
QUIT
+9 IF $EXTRACT(I,1,3)'=($EXTRACT(DGBTA,1,3)-1)
QUIT
+10 IF $$GET1^DIQ(392.7,I,8,"I")<$PIECE(DGBTA,".")
QUIT
+11 SET DGBTDW=^DGBT(392.7,I,0)
End DoDot:1
if DGBTDW'=""
QUIT
+12 IF DGBTDW=""
QUIT ""
+13 IF $PIECE(DGBTDW,"^",3)=0
QUIT ""
+14 IF $PIECE(DGBTA,".")<$PIECE($PIECE(DGBTDW,U),".")
QUIT ""
+15 IF INEX="IN"
QUIT EXPDT
+16 IF $GET(EXPDT)="PENSION"
QUIT "WAIVER EXPIRES: PENSION"
+17 IF EXPDT<$PIECE(DGBTDTI,".")
QUIT ""
+18 QUIT "WAIVER EXPIRES: "_$$DTFORM(EXPDT)
+19 ;
LSTMTDT(DFN) ;this will return the last means test date
+1 NEW MTIEN
+2 SET MTIEN=""
+3 SET MTIEN=$ORDER(^DGMT(408.31,"C",DFN,MTIEN),-1)
+4 SET LSTMTDT=$PIECE(^DGMT(408.31,MTIEN,0),"^",1)
+5 QUIT LSTMTDT
+6 ;
LSTMTRIN(DFN,DGBTDTI) ;this will return whether the patient refused to give income
+1 NEW MTIEN,REFUSED
+2 SET REFUSED=1
+3 SET MTIEN=+$$LST^DGMTCOU1(DFN,DGBTDTI,3)
+4 IF MTIEN'=""
SET REFUSED=$$GET1^DIQ(408.31,MTIEN,.14,"I")
+5 QUIT REFUSED
