DGBTRDVW ;ALB/RFE - BENEFICIARY/TRAVEL UTILITY ROUTINES ;07/03/12
;;1.0;Beneficiary Travel;**20,25,30,38**;September 25, 2001;Build 2
Q
WAIV(DFN,DGBTDTI) ;
N %H,DED,I,TRIP,TRIPCT,RETURN,DGBTDW,EXPDT,FUTURE,FDED,WAIVER
;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) ^ type of waiver i.e. MAN for manual, PENSION etc. ^
;total number of trips as of this claim date ^ deductible as of this claim date
S TRIP=$$TRIP
S WAIVER=$$WAIVYN
S RETURN=TRIP_WAIVER_U_(TRIPCT-FUTURE)_U_(DED-FDED)
Q RETURN
;
TRIP() ;
N DTRAY,I,TRIPS,TRIPTYP,MONTH,DGBTDT,ACCTYPE,DGBTEND
S (DED,TRIPCT,FUTURE,FDED)=0
F I=0:1:2 S TRIPS(I)=0
S DGBTEND=$E(DGBTDTI,1,5)+1_"00"
S (MONTH,DGBTDT)=$E(DGBTDTI,1,5)_"00"
;F S DGBTDT=$O(^DGBT(392,"C",DFN,DGBTDT)) Q:DGBTDT=""!(DGBTDT>DGBTDTI) D
F S DGBTDT=$O(^DGBT(392,"C",DFN,DGBTDT)) Q:DGBTDT=""!(DGBTDT'<DGBTEND) D
.I (DGBTDT=DGBTDTI)&($G(CHZFLG)=0) Q
.Q:$$GET1^DIQ(392,DGBTDT,56,"I")="S"
.I $$GET1^DIQ(392,DGBTDT,45.2,"I")=1 Q
.I $D(DTRAY(DGBTDT)) Q ;dbe patch DGBT*1*25
.S ACCTYPE=$$GET1^DIQ(392.3,$$GET1^DIQ(392,DGBTDT,6,"I"),5,"I")
.I ACCTYPE="" Q
.I 45'[ACCTYPE Q
.S DTRAY(DGBTDT)="" ;dbe patch DGBT*1*25
.S DED=DED+$$GET1^DIQ(392,DGBTDT,9)
.S TRIPTYP=+$$GET1^DIQ(392,DGBTDT,31,"I")
.S TRIPS(TRIPTYP)=TRIPS(TRIPTYP)+1
.S TRIPCT=TRIPCT+TRIPTYP
.I ($G(CHZFLG))&(DGBTDT=DGBTDTI) S FUTURE=FUTURE+TRIPTYP,FDED=FDED+$$GET1^DIQ(392,DGBTDT,9,"I") ;*30 modified check to use date/time
Q TRIPCT_U_TRIPS(1)_U_TRIPS(2)_U_DED_U
WAIVYN() ;
I DED'<18 Q "1^DED^"
I TRIPCT>6 Q "1^TRIPS^"
I '$D(DGBTINCA) N DGBTINCA,DGBTERR D GA^DGBTUTL(DFN,"DGBTINCA",DGBTDTI)
I DGBTINCA Q "1^ALTINC^"
I $$MANRQ Q "1^MAN^"_EXPDT
I '$D(VAEL) N VAEL,VAERR D ELIG^VADPT
I $$PENSION Q "1^PENSION^"
;I '$D(DGBTDEP) N DGBTDEP S DGBTDEP=$$DEP^VAFMON(DFN,DGBTDTI)
;I '$D(DGBTNSC) N DGBTNSC S DGBTNSC=$$NSC^DGBTUTL
;I '$D(DGBTINC) N DGBTINC S DGBTINC=$$INCOME^VAFMON(DFN,DGBTDTI,1)
;I '$D(DGBTMTTH) N DGBTMTTH S DGBTMTTH=$$MTTH^DGBTMTTH(DGBTDEP,DGBTDTI)
;I (DGBTNSC)&(+$TR($P(DGBTINC,U),"$,","")<DGBTRXTH) Q "1^NSC^"
;I '(DGBTNSC)&(+$G(VAEL(3)))&(+$TR($P(DGBTINC,U),"$,","")<DGBTMTTH) Q "1^LI^"
;I '(DGBTNSC),+$$LI^DGBTUTL(DFN,DGBTDTI,DGBTDEP,,DGBTINCA)'=0 Q "1^LI^"
Q 0_"^^"
MANRQ() ; Manual waiver request
I '$D(^DGBT(392.7,"C",DFN)) Q 0_"^"
N STDT
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 STDT=$$GET1^DIQ(392.7,I,.01,"I")
.I STDT>DGBTDTI S DGBTDW=0 Q
.S EXPDT=$$GET1^DIQ(392.7,I,8,"I")
.I EXPDT="PENSION" S DGBTDW=1 Q
.I $E(I,1,3)=$E(DGBTDTI,1,3) S DGBTDW=^DGBT(392.7,I,0) Q
.I $E(I,1,3)'=($E(DGBTDTI,1,3)-1) Q ;*38 - changed variable to DGBTDTI to prevent undefined error when called via rpc
.I $$GET1^DIQ(392.7,I,8,"I")<$P(DGBTDTI,".") Q
.S DGBTDW=^DGBT(392.7,I,0)
I DGBTDW="" Q 0
I $$GET1^DIQ(392.7,I,3)="NO" Q 0
I $G(EXPDT)="PENSION" Q 1
I $P(DGBTDTI,".")<$P($P(DGBTDW,U),".") Q 0
I $G(EXPDT)?7N S EXPDT=$$DTFORM^DGBT1(EXPDT)
Q DGBTDW
PENSION() ;
I '$D(VAEL) N VAEL,VAERR D ELIG^VADPT
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTRDVW 3587 printed Apr 09, 2024@20:45:53 Page 2
DGBTRDVW ;ALB/RFE - BENEFICIARY/TRAVEL UTILITY ROUTINES ;07/03/12
+1 ;;1.0;Beneficiary Travel;**20,25,30,38**;September 25, 2001;Build 2
+2 QUIT
WAIV(DFN,DGBTDTI) ;
+1 NEW %H,DED,I,TRIP,TRIPCT,RETURN,DGBTDW,EXPDT,FUTURE,FDED,WAIVER
+2 ;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) ^ type of waiver i.e. MAN for manual, PENSION etc. ^
+3 ;total number of trips as of this claim date ^ deductible as of this claim date
+4 SET TRIP=$$TRIP
+5 SET WAIVER=$$WAIVYN
+6 SET RETURN=TRIP_WAIVER_U_(TRIPCT-FUTURE)_U_(DED-FDED)
+7 QUIT RETURN
+8 ;
TRIP() ;
+1 NEW DTRAY,I,TRIPS,TRIPTYP,MONTH,DGBTDT,ACCTYPE,DGBTEND
+2 SET (DED,TRIPCT,FUTURE,FDED)=0
+3 FOR I=0:1:2
SET TRIPS(I)=0
+4 SET DGBTEND=$EXTRACT(DGBTDTI,1,5)+1_"00"
+5 SET (MONTH,DGBTDT)=$EXTRACT(DGBTDTI,1,5)_"00"
+6 ;F S DGBTDT=$O(^DGBT(392,"C",DFN,DGBTDT)) Q:DGBTDT=""!(DGBTDT>DGBTDTI) D
+7 FOR
SET DGBTDT=$ORDER(^DGBT(392,"C",DFN,DGBTDT))
if DGBTDT=""!(DGBTDT'<DGBTEND)
QUIT
Begin DoDot:1
+8 IF (DGBTDT=DGBTDTI)&($GET(CHZFLG)=0)
QUIT
+9 if $$GET1^DIQ(392,DGBTDT,56,"I")="S"
QUIT
+10 IF $$GET1^DIQ(392,DGBTDT,45.2,"I")=1
QUIT
+11 ;dbe patch DGBT*1*25
IF $DATA(DTRAY(DGBTDT))
QUIT
+12 SET ACCTYPE=$$GET1^DIQ(392.3,$$GET1^DIQ(392,DGBTDT,6,"I"),5,"I")
+13 IF ACCTYPE=""
QUIT
+14 IF 45'[ACCTYPE
QUIT
+15 ;dbe patch DGBT*1*25
SET DTRAY(DGBTDT)=""
+16 SET DED=DED+$$GET1^DIQ(392,DGBTDT,9)
+17 SET TRIPTYP=+$$GET1^DIQ(392,DGBTDT,31,"I")
+18 SET TRIPS(TRIPTYP)=TRIPS(TRIPTYP)+1
+19 SET TRIPCT=TRIPCT+TRIPTYP
+20 ;*30 modified check to use date/time
IF ($GET(CHZFLG))&(DGBTDT=DGBTDTI)
SET FUTURE=FUTURE+TRIPTYP
SET FDED=FDED+$$GET1^DIQ(392,DGBTDT,9,"I")
End DoDot:1
+21 QUIT TRIPCT_U_TRIPS(1)_U_TRIPS(2)_U_DED_U
WAIVYN() ;
+1 IF DED'<18
QUIT "1^DED^"
+2 IF TRIPCT>6
QUIT "1^TRIPS^"
+3 IF '$DATA(DGBTINCA)
NEW DGBTINCA,DGBTERR
DO GA^DGBTUTL(DFN,"DGBTINCA",DGBTDTI)
+4 IF DGBTINCA
QUIT "1^ALTINC^"
+5 IF $$MANRQ
QUIT "1^MAN^"_EXPDT
+6 IF '$DATA(VAEL)
NEW VAEL,VAERR
DO ELIG^VADPT
+7 IF $$PENSION
QUIT "1^PENSION^"
+8 ;I '$D(DGBTDEP) N DGBTDEP S DGBTDEP=$$DEP^VAFMON(DFN,DGBTDTI)
+9 ;I '$D(DGBTNSC) N DGBTNSC S DGBTNSC=$$NSC^DGBTUTL
+10 ;I '$D(DGBTINC) N DGBTINC S DGBTINC=$$INCOME^VAFMON(DFN,DGBTDTI,1)
+11 ;I '$D(DGBTMTTH) N DGBTMTTH S DGBTMTTH=$$MTTH^DGBTMTTH(DGBTDEP,DGBTDTI)
+12 ;I (DGBTNSC)&(+$TR($P(DGBTINC,U),"$,","")<DGBTRXTH) Q "1^NSC^"
+13 ;I '(DGBTNSC)&(+$G(VAEL(3)))&(+$TR($P(DGBTINC,U),"$,","")<DGBTMTTH) Q "1^LI^"
+14 ;I '(DGBTNSC),+$$LI^DGBTUTL(DFN,DGBTDTI,DGBTDEP,,DGBTINCA)'=0 Q "1^LI^"
+15 QUIT 0_"^^"
MANRQ() ; Manual waiver request
+1 IF '$DATA(^DGBT(392.7,"C",DFN))
QUIT 0_"^"
+2 NEW STDT
+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 STDT=$$GET1^DIQ(392.7,I,.01,"I")
+7 IF STDT>DGBTDTI
SET DGBTDW=0
QUIT
+8 SET EXPDT=$$GET1^DIQ(392.7,I,8,"I")
+9 IF EXPDT="PENSION"
SET DGBTDW=1
QUIT
+10 IF $EXTRACT(I,1,3)=$EXTRACT(DGBTDTI,1,3)
SET DGBTDW=^DGBT(392.7,I,0)
QUIT
+11 ;*38 - changed variable to DGBTDTI to prevent undefined error when called via rpc
IF $EXTRACT(I,1,3)'=($EXTRACT(DGBTDTI,1,3)-1)
QUIT
+12 IF $$GET1^DIQ(392.7,I,8,"I")<$PIECE(DGBTDTI,".")
QUIT
+13 SET DGBTDW=^DGBT(392.7,I,0)
End DoDot:1
if DGBTDW'=""
QUIT
+14 IF DGBTDW=""
QUIT 0
+15 IF $$GET1^DIQ(392.7,I,3)="NO"
QUIT 0
+16 IF $GET(EXPDT)="PENSION"
QUIT 1
+17 IF $PIECE(DGBTDTI,".")<$PIECE($PIECE(DGBTDW,U),".")
QUIT 0
+18 IF $GET(EXPDT)?7N
SET EXPDT=$$DTFORM^DGBT1(EXPDT)
+19 QUIT DGBTDW
PENSION() ;
+1 IF '$DATA(VAEL)
NEW VAEL,VAERR
DO ELIG^VADPT
+2 IF VAEL(1)["PENSION"
QUIT 1
+3 IF $PIECE(VAEL(1),"^",2)="AID & ATTENDANCE"
QUIT 1
+4 IF $PIECE(VAEL(1),"^",2)="HOUSEBOUND"
QUIT 1
+5 NEW HIT
+6 SET (HIT,I)=""
+7 FOR
SET I=$ORDER(VAEL(1,I))
if I=""
QUIT
Begin DoDot:1
+8 IF VAEL(1,I)["PENSION"
SET HIT=1
QUIT
+9 ;*30 added to prevent waiver for 100% SC
IF $PIECE(VAEL(3),U,2)'=100
Begin DoDot:2
+10 IF $PIECE(VAEL(1,I),"^",2)="AID & ATTENDANCE"
SET HIT=1
QUIT
+11 IF $PIECE(VAEL(1,I),"^",2)="HOUSEBOUND"
SET HIT=1
QUIT
End DoDot:2
End DoDot:1
if HIT
QUIT
+12 QUIT HIT
