- 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 Feb 18, 2025@23:06:31 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