Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGBT1

DGBT1.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. SCREEN ; clear screen and write headers
  1. N TOTRIPS,ONEWAY,RT,MONTHDED,WAIVER,WTYPE,TTRIPS,TDED,TFIEN,DGBTOTHER
  1. D MONTOT(.TOTRIPS,.ONEWAY,.RT,.MONTHDED,.WAIVER,.WTYPE,.TTRIPS,.TDED) Q:$G(DGBTQUIT)
  1. S DGBTOTHER=0
  1. W @IOF
  1. W !?18,"Beneficiary Travel Claim Information <Screen 1>"
  1. W !!?2,"Claim Date: ",DGBTDTE
  1. D PID^VADPT6,RESADDR^DGBTUTL1(.DGBTADDR) W !!?8,"Name: ",VADM(1),?40,"PT ID: ",VA("PID"),?64,"DOB: ",$P(VADM(3),"^",2)
  1. I '$G(CHZFLG)!('$D(^DGBT(392,DGBTDT,"D"))) D ;*39 - updated to use residential address
  1. .W !!?5,"Address: ",DGBTADDR(1)
  1. .W:DGBTADDR(2)]"" !?14,DGBTADDR(2)
  1. .W:DGBTADDR(3)]"" !?14,DGBTADDR(3)
  1. .W !?14,DGBTADDR(4),$S(DGBTADDR(4)]"":", "_$P(DGBTADDR(5),"^",2)_" "_$P(DGBTADDR(6),"^",2),1:"UNSPECIFIED")
  1. I $G(CHZFLG),$D(^DGBT(392,DGBTDT,"D")) D
  1. .N CLMADD,CLMST
  1. .S CLMADD=^DGBT(392,DGBTDT,"D")
  1. .S CLMST=$P(CLMADD,"^",5) S:$G(CLMST)'="" CLMST=$P(^DIC(5,CLMST,0),"^",2)
  1. .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")
  1. W !!?5,$$ADDCHG(DFN)
  1. ;
  1. SETVAR ; if new claim, move in current info for elig, sc%
  1. I 'CHZFLG S DGBTELG=VAEL(1),DGBTCSC=VAEL(3)
  1. I +DGBTELG=3,'$E(DGBTCSC)=1 S DGBTCSC=1
  1. I ($P(DGBTELG,U,2)["NSC")&(DGBTDYFL)&'($G(DGBTREF)) D
  1. .I +$TR($P(DGBTINC,U),"$,","")<DGBTRXTH S $P(DGBTELG,U,2)=$P(DGBTELG,U,2)_" LOW INCOME"
  1. W !!," Eligibility: ",$P(DGBTELG,"^",2) W:DGBTCSC ?45,"SC%: ",$P(DGBTCSC,"^",2) ;W !
  1. I $O(VAEL(1,0))'="" W !," Other Elig.: " F I=0:0 S I=$O(VAEL(1,I)) Q:'I D
  1. .W ?14,$P(VAEL(1,I),"^",2),!
  1. .I VAEL(1,I)["HOUSEBOUND" S DGBTOTHER=1
  1. .I VAEL(1,I)["AID & ATTENDANCE" S DGBTOTHER=1
  1. .I VAEL(1,I)["PENSION" S DGBTOTHER=1
  1. ;
  1. SC ; service connected status/information
  1. I DGBTCSC&($P(DGBTCSC,"^",2)'>29) W !!,"Disabilities:" S I3=""
  1. N DGQUIT
  1. F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I!($G(DGQUIT)=1) D
  1. . 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
  1. . I $Y>(IOSL-3) D PAUSE I DGQUIT=0 W @IOF
  1. . I $G(DGQUIT)=1 Q
  1. .D
  1. ..I DGBTCSC&($P(DGBTCSC,"^",2)'>29) Q
  1. ..I I=$O(^DPT(DFN,.372,0)) W !
  1. . W ?16 W I2,!
  1. ;
  1. INCOME ; income and eligibility information
  1. ;DAYFLG = NUMBER OF DAYS SINCE LAST MEANS TEST
  1. N DGBTIFL,DGBTDATA,TESTDATE,DGBTDAYS,DGNOTEST,RXCP,RXCPST,DGRXDATA,RXDAYS,RXCPDATA,RXCPTS,DGBTST,BUSEXP,LOWINC,NOTEST
  1. ;
  1. ;
  1. S DGBTIFL=$P(DGBTINC,U,2)
  1. S (DAYFLG,RXDAYS,RXCPTS)=""
  1. ;CHECK HOW DAYS SINCE LAST MEANS TEST
  1. I $$DAYSTEST(DFN,.DAYFLG,.RXDAYS,.RXCPST,.LOWINC,.DGNOTEST)
  1. ;
  1. ; added for patch *24 to check for VFA MT currency and reset DAYFLG as needed
  1. I $$MTCHK^DGBTUTL1(DFN,$P(DGBTDT,".",1))>0 D
  1. . S (DAYFLG,DGBTDYFL)=1
  1. ;
  1. S BUSEXP=$$ABP^DGBTUTL(DFN)
  1. ;
  1. ;CHANGED FOR DGBT*1*20
  1. S ELIGTYP=$$GET1^DIQ(8.1,3_",",.01)
  1. 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"
  1. I $G(BUSEXP) D
  1. .S Y=BUSEXP X ^DD("DD")
  1. .W !!?2,"BT Alert: BUS PASS ISSUED - EXPIRES ",Y
  1. ;
  1. I (DAYFLG!DGBTINCA),'$G(RXCPST) D D QUIT Q ;valid mt in last 365 days + PAVEL
  1. .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:"")
  1. .W !?2,"No. of Dependents: ",DGBTDEP
  1. .;
  1. .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))
  1. .W:$P(DGBTMTS,"^")="P" !?68,$P($P(DGBTMTS,"^",2)," ",2)
  1. .I $P(DGBTMTS,"^")="N" W !!?20,"MEANS TEST ",$P(DGBTMTS,"^",2)
  1. .;
  1. .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")
  1. .I $D(DGBTCE) I DGBTCE'=1 W *7,*7,!!?8,"* * * NOTE * * PATIENT HAS BEEN CERTIFIED INELIGIBLE BASED ON INCOME"
  1. .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
  1. .I '$D(DGBTRET(0)) W !,?50,$$WVEXP ;*DGBT*1.0*20 BLD * E2
  1. .I $D(DGBTRET(0)),$P(DGBTRET(0),"^",6)'="MAN" W !,?50,$$WVEXP ; /*DGBT*1.0*20 RFE */
  1. .I $D(DGBTRET(0)),$P(DGBTRET(0),"^",6)="MAN" W !,?52,"WAIVER EXPIRES: ",$P(DGBTRET(0),"^",7)
  1. .F I=$Y:1:20 W !
  1. ;
  1. ;no valid mt test in last 365 days or no test has been done
  1. I 'DAYFLG D D QUIT Q
  1. .W !!?2,"Income: ","",?40,"Source of Income: ",""
  1. .W !?2,"No. of Dependents: ",DGBTDEP
  1. .I DGBTMTS]"" W ?40,"MT Status: ","EXPIRED"
  1. .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")
  1. .I '$D(DGBTRET(0)) W !,?50,$$WVEXP ;*DGBT*1.0*20 BLD * E2
  1. .I $D(DGBTRET(0)),$P(DGBTRET(0),"^",6)'="MAN" W !,?50,$$WVEXP ; /*DGBT*1.0*20 RFE */
  1. .I $D(DGBTRET(0)),$P(DGBTRET(0),"^",6)="MAN" W !,?52,"WAIVER EXPIRES: ",$P(DGBTRET(0),"^",7)
  1. .F I=$Y:1:20 W !
  1. ;
  1. I DAYFLG,$G(RXCPST) D
  1. .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")
  1. .I $G(RXCP)'=1,$P($G(DGBTINCA),"^",2)="" W !!?2,"Income: ",DGBTDTY,?40,"Source of Income: ","COPAY TEST" ;RXCP'=1 Copy NON-EXEMPT
  1. .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")
  1. .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
  1. .W !?2,"No. of Dependents: ",DGBTDEP
  1. .I DGBTMTS]"" W ?40,"MT Status: ","NOT APPLICABLE"
  1. .W !!?2,"BT Income: ","INELIGIBLE"
  1. .I '$D(DGBTRET(0)) W ?50,$$WVEXP ;*DGBT*1.0*20 BLD * E2
  1. .I $D(DGBTRET(0)),$P(DGBTRET(0),"^",6)'="MAN" W ?50,$$WVEXP ; /*DGBT*1.0*20 RFE */
  1. .I $D(DGBTRET(0)),$P(DGBTRET(0),"^",6)="MAN" W ?52,"WAIVER EXPIRES: ",$P(DGBTRET(0),"^",7)
  1. .F I=$Y:1:20 W !
  1. ;
  1. QUIT ;
  1. K I1,I2,I3
  1. D MONTDISP(TOTRIPS,ONEWAY,RT,MONTHDED,WAIVER,WTYPE)
  1. Q
  1. ;
  1. MONTOT(TOTRIPS,ONEWAY,RT,MONTHDED,WAIVER,WTYPE,TTRIPS,TDED) ;
  1. ;
  1. N RETURN
  1. S RETURN=""
  1. ;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) ^
  1. ;total number of trips as of this claim date ^ deductible as of this claim date
  1. ;from the local data base
  1. S RETURN=$$WAIV^DGBTRDVW(DFN,DGBTDTI)
  1. S ONEWAY=$S($P($G(RETURN),"^",2):$P($G(RETURN),"^",2),1:0)
  1. S RT=$S($P($G(RETURN),"^",3):$P($G(RETURN),"^",3),1:0)
  1. S WAIVER=$S($P($G(RETURN),"^",5)=1:"YES",1:"NO")
  1. S MONTHDED=$S($P($G(RETURN),"^",4):$P($G(RETURN),"^",4),1:0)
  1. S WTYPE=$P(RETURN,"^",5)
  1. S TOTRIPS=(RT*2)+ONEWAY
  1. S TTRIPS=$S($P($G(RETURN),U,8):$P($G(RETURN),U,8),1:0)
  1. S TDED=$S($P($G(RETURN),U,9):$P($G(RETURN),U,9),1:0)
  1. S DGBTREF=0
  1. S DGBTREF=$$LSTMTRIN(DFN,DGBTDTI)
  1. I (WAIVER="NO")&($G(DGBTDYFL)) D
  1. .I DGBTNSC D Q
  1. ..N INCOME
  1. ..S INCOME=+$TR($P($G(DGBTINC),U),"$,","")
  1. ..I INCOME'="",INCOME<DGBTRXTH,'$G(DGBTREF) S WAIVER="YES",$P(RETURN,U,5)=1,$P(RETURN,U,6)="NSC"
  1. ..;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"
  1. .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
  1. .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"
  1. .I $P($G(DGBTINC),"^",1)="" S $P(RETURN,"^",6)=""
  1. 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
  1. .S RETURN=""
  1. .D OPT^DGBTRDV(DFN,DGBTDTI) I $G(RDVMSG) W $$PAUSE^DGBTUTL(0) S:$G(Y)="^" DGBTQUIT=1 Q:$G(DGBTQUIT)!($G(DGBTRET(0))="")
  1. .I $G(RDVMSG) W $$PAUSE^DGBTUTL(0)
  1. .S ONEWAY=$G(ONEWAY)+$P(RETURN,"^",2)
  1. .S RT=$G(RT)+$P(RETURN,"^",3)
  1. .S MONTHDED=$G(MONTHDED)+$P(RETURN,"^",4)
  1. .S TOTRIPS=TOTRIPS+$P(RETURN,"^",1)
  1. .S TTRIPS=TTRIPS+$P(RETURN,U,8)
  1. .S TDED=TDED+$P(RETURN,U,9)
  1. .S $P(RETURN,"^",1)=TOTRIPS
  1. .S $P(RETURN,"^",8)=TTRIPS
  1. .S $P(RETURN,"^",9)=TDED
  1. .I $P(RETURN,"^",5)'=1 S $P(RETURN,"^",5)=$S(TTRIPS>6:1,TDED>18:0,1:$P(RETURN,"^",5))
  1. .S WAIVER=$S($P(RETURN,"^",5)=1:"YES",1:"NO")
  1. I WAIVER'="YES" S WAIVER=$S($P(RETURN,"^",1)>=6:"YES",1:"NO") ;*30 added greater than or equal to
  1. S MONTOT=$G(TOTRIPS)_"^"_$G(ONEWAY)_"^"_$G(RT)_"^"_$G(MONTHDED)_"^"_$G(WAIVER)_U_$G(TTRIPS)_U_$G(TDED)
  1. Q
  1. ;
  1. MONTDISP(TOTRIPS,ONEWAY,RT,MONTHDED,WAIVER,WTYPE) ;
  1. ;
  1. W !?2,"TOTAL TRIPS THIS MONTH: ",$G(ONEWAY)_" ONE WAY, ",$G(RT)_" RD TRIP"
  1. W ?52,"WAIVER GRANTED: ",$G(WAIVER)
  1. W !?2,"TOTAL DEDUCTIBLE THIS MONTH: ",MONTHDED
  1. ;
  1. Q
  1. ;
  1. PAUSE ;added with DGBT*1*11
  1. I $E(IOST,1,2)["C-" N DIR S DIR(0)="E" D ^DIR S DGQUIT='Y
  1. Q
  1. ;
  1. DAYSTEST(DFN,DAYFLG,RXDAYS,RXCPST,LOWINC,NOTEST) ;determines whether or not a valid MT in last 365 days.
  1. N DGBTDATA,TESTDATA,DGBTDAYS,DGMTSTAT,DGBTST,DGRXDATA,DGTSTTYP,DGMTST,X,DGMTYPT1,THRESHLD,INCOM
  1. S DGMTYPT1=3,DAYFLG=0,(DGMTST,RXCPST,THRESHLD,INCOM)=""
  1. S DGBTDATA=$$LST^DGMTCOU1(DFN,$P(DGBTDT,".",1),.DGMTYPT1)
  1. I DGBTDATA'="" D
  1. .S TESTDATE=$$LSTMTDT(DFN)
  1. .S DGBTDAYS=$$FMDIFF^XLFDT($P(DGBTDTI,".",1),TESTDATE) ;get number of days from claim date to last MT
  1. .S DAYFLG=$S(DGBTDAYS>365:0,1:1) ;if greater than 365 days then no valid MT test
  1. .I DGMTYPT1=1 S DGMTST=$P(DGBTDATA,"^",3)="NO LONGER REQUIRED"
  1. .I DGMTYPT1=2 S RXCPST=$P(DGBTDATA,"^",3)="NON-EXEMPT"
  1. .S:RXCPST'=1 RXCP=1 ;************************
  1. .S DGBTRET=$S(+$$LI^DGBTUTL(DFN,DGBTDTI,DGBTDEP,,DGBTINCA):"1^",1:"0^") ;Get Low Income + count Alternate Income PAVEL
  1. .S LOWINC=$P(DGBTRET,"^",1)
  1. I $G(DAYFLG)=0 S DGNOTEST=1
  1. Q ""
  1. ;
  1. ADDCHG(DFN) ;this will print the permanent Address last changed date or the Temporary Address last change date
  1. ;
  1. N DATE,TMPADD
  1. S TMPADD=$S($$GET1^DIQ(2,DFN,.12105)="YES":0,1:1)
  1. I TMPADD D
  1. .S DATE="Date Address Last Changed: "_$P($$GET1^DIQ(2,DFN,.118),"@",1)
  1. E S DATE="Date Address Last Changed: "_$P($$GET1^DIQ(2,DFN,.12113),"@",1)
  1. ;
  1. Q DATE
  1. ;
  1. WVEXP() ; Waiver expiration date ; /* Tagline added DGBT*1.0*20 RFE */
  1. N RETURN,VFADT,VFAMTDT,VFAMTDTP
  1. I $$WVELG Q "WAIVER EXPIRES: PENSION"
  1. N WVREQEXP
  1. I $D(^DGBT(392.7,"C",DFN)) S WVREQEXP=$$WVREQ("IN")
  1. I $G(WVREQEXP)="PENSION" Q "WAIVER EXPIRES: PENSION"
  1. N DGMTYPT1,TESTDATEI
  1. S TESTDATE=$$TESTDATE
  1. S TESTDATEI=$$DTFORMI(TESTDATE)
  1. I TESTDATEI<$P(DGBTDTI,".") Q ""
  1. I +$G(DGBTINCA) Q "WAIVER EXPIRES: "_TESTDATE
  1. I '+$G(LOWINC) Q $$WVREQ("EX")
  1. N LABL
  1. S LABL=$S($G(DGMTYPT1)=1:"MEANS TEST ",$G(DGMTYPT1)=2:"COPAY TEST ",1:"WAIVER ")_"EXPIRES: "
  1. ; ADDED FOR PATCH 24 VFA MT DO NOT EXPIRE
  1. S VFADT=+$$GET1^DIQ(43,"1,",1205,"I",,"ERR")
  1. S VFAMTDT=$P($$LST^DGMTCOU1(DFN,$P(DGBTDTI,"."),3),U,2),VFAMTDTP=$$FMADD^XLFDT(VFAMTDT,365,0,0,0)
  1. I VFAMTDTP'<VFADT&(LABL["MEANS TEST") Q "MEANS TEST DO NOT EXPIRE"
  1. ;
  1. Q LABL_TESTDATE
  1. ;
  1. TESTDATE() ;
  1. I (+$G(DGBTINCA)),($G(WVREQEXP)>$P(DGBTINCA,U,5)) Q $$DTFORM(WVREQEXP)
  1. I +$G(DGBTINCA) Q $$DTFORM($P(DGBTINCA,U,5))
  1. S DGMTYPT1=3
  1. S TESTDATE=$P($$LST^DGMTCOU1(DFN,DGBTDTI,.DGMTYPT1),U,2)
  1. I 'DAYFLG S (TESTDATE,DGMTYPT1)=0
  1. I (+TESTDATE=0),($E($G(WVREQEXP),1,3)>$E(DGBTDTI,1,3)) Q $$DTFORM(WVREQEXP)
  1. I +TESTDATE=0 Q "12/31/"_$E(DGBTDTI,2,3)
  1. Q $$DTFORM(($E(TESTDATE,1,3)+1)_$E(TESTDATE,4,7))
  1. ;
  1. DTFORM(INTDT) ;
  1. Q $E(INTDT,4,5)_"/"_$E(INTDT,6,7)_"/"_$E(INTDT,2,3)
  1. ;
  1. DTFORMI(TESTDATE) ;
  1. Q 3_$P(TESTDATE,"/",3)_$P(TESTDATE,"/",2)_$P(TESTDATE,"/")
  1. ;
  1. WVELG() ; Eligibility for waiver being PENSION DGBT*1.0*20 RFE
  1. I VAEL(1)["PENSION" Q 1
  1. I $P(VAEL(1),"^",2)="AID & ATTENDANCE" Q 1
  1. I $P(VAEL(1),"^",2)="HOUSEBOUND" Q 1
  1. N HIT
  1. S (HIT,I)=""
  1. F S I=$O(VAEL(1,I)) Q:I="" D Q:HIT
  1. .I VAEL(1,I)["PENSION" S HIT=1 Q
  1. .I $P(VAEL(3),U,2)'=100 D ;*30 added to prevent waiver for 100% SC
  1. ..I $P(VAEL(1,I),"^",2)="AID & ATTENDANCE" S HIT=1 Q
  1. ..I $P(VAEL(1,I),"^",2)="HOUSEBOUND" S HIT=1 Q
  1. Q HIT
  1. ;
  1. YEAR(DT1) ; DT2 will be a year after DT1 ; /*Tagline added DGBT*1.0*20 RFE */
  1. N DT2,MO,YR
  1. S DT2=$$FMTH^XLFDT(DT1,1)+365
  1. S YR=+$E(DT1,2,3),MO=+$E(DT1,4,5)
  1. I (YR#4=3),(MO>2) S DT2=DT2+1 ; Leap year
  1. I (YR#4=0),(MO<3) S DT2=DT2+1 ; Leap year
  1. Q DT2
  1. ;
  1. WVREQ(INEX) ; Manual deductible waiver request DGBT*1.0*20 RFE
  1. I '$D(^DGBT(392.7,"C",DFN)) Q ""
  1. N DGBTDW,EXPDT
  1. S (DGBTDW,I)=""
  1. F S I=$O(^DGBT(392.7,"C",DFN,I),-1) Q:I="" D Q:DGBTDW'=""
  1. .I $$GET1^DIQ(392.7,I,97,"I") Q
  1. . S EXPDT=$$GET1^DIQ(392.7,I,8,"I")
  1. . I EXPDT="PENSION" S DGBTDW=1 Q
  1. . I $E(I,1,3)=$E(DGBTA,1,3) S DGBTDW=^DGBT(392.7,I,0) Q
  1. . I $E(I,1,3)'=($E(DGBTA,1,3)-1) Q
  1. . I $$GET1^DIQ(392.7,I,8,"I")<$P(DGBTA,".") Q
  1. . S DGBTDW=^DGBT(392.7,I,0)
  1. I DGBTDW="" Q ""
  1. I $P(DGBTDW,"^",3)=0 Q ""
  1. I $P(DGBTA,".")<$P($P(DGBTDW,U),".") Q ""
  1. I INEX="IN" Q EXPDT
  1. I $G(EXPDT)="PENSION" Q "WAIVER EXPIRES: PENSION"
  1. I EXPDT<$P(DGBTDTI,".") Q ""
  1. Q "WAIVER EXPIRES: "_$$DTFORM(EXPDT)
  1. ;
  1. LSTMTDT(DFN) ;this will return the last means test date
  1. N MTIEN
  1. S MTIEN=""
  1. S MTIEN=$O(^DGMT(408.31,"C",DFN,MTIEN),-1)
  1. S LSTMTDT=$P(^DGMT(408.31,MTIEN,0),"^",1)
  1. Q LSTMTDT
  1. ;
  1. LSTMTRIN(DFN,DGBTDTI) ;this will return whether the patient refused to give income
  1. N MTIEN,REFUSED
  1. S REFUSED=1
  1. S MTIEN=+$$LST^DGMTCOU1(DFN,DGBTDTI,3)
  1. I MTIEN'="" S REFUSED=$$GET1^DIQ(408.31,MTIEN,.14,"I")
  1. Q REFUSED