- 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 Feb 18, 2025@23:07:28 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