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

DGBTRDVW.m

Go to the documentation of this file.
  1. DGBTRDVW ;ALB/RFE - BENEFICIARY/TRAVEL UTILITY ROUTINES ;07/03/12
  1. ;;1.0;Beneficiary Travel;**20,25,30,38**;September 25, 2001;Build 2
  1. Q
  1. WAIV(DFN,DGBTDTI) ;
  1. N %H,DED,I,TRIP,TRIPCT,RETURN,DGBTDW,EXPDT,FUTURE,FDED,WAIVER
  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) ^ type of waiver i.e. MAN for manual, PENSION etc. ^
  1. ;total number of trips as of this claim date ^ deductible as of this claim date
  1. S TRIP=$$TRIP
  1. S WAIVER=$$WAIVYN
  1. S RETURN=TRIP_WAIVER_U_(TRIPCT-FUTURE)_U_(DED-FDED)
  1. Q RETURN
  1. ;
  1. TRIP() ;
  1. N DTRAY,I,TRIPS,TRIPTYP,MONTH,DGBTDT,ACCTYPE,DGBTEND
  1. S (DED,TRIPCT,FUTURE,FDED)=0
  1. F I=0:1:2 S TRIPS(I)=0
  1. S DGBTEND=$E(DGBTDTI,1,5)+1_"00"
  1. S (MONTH,DGBTDT)=$E(DGBTDTI,1,5)_"00"
  1. ;F S DGBTDT=$O(^DGBT(392,"C",DFN,DGBTDT)) Q:DGBTDT=""!(DGBTDT>DGBTDTI) D
  1. F S DGBTDT=$O(^DGBT(392,"C",DFN,DGBTDT)) Q:DGBTDT=""!(DGBTDT'<DGBTEND) D
  1. .I (DGBTDT=DGBTDTI)&($G(CHZFLG)=0) Q
  1. .Q:$$GET1^DIQ(392,DGBTDT,56,"I")="S"
  1. .I $$GET1^DIQ(392,DGBTDT,45.2,"I")=1 Q
  1. .I $D(DTRAY(DGBTDT)) Q ;dbe patch DGBT*1*25
  1. .S ACCTYPE=$$GET1^DIQ(392.3,$$GET1^DIQ(392,DGBTDT,6,"I"),5,"I")
  1. .I ACCTYPE="" Q
  1. .I 45'[ACCTYPE Q
  1. .S DTRAY(DGBTDT)="" ;dbe patch DGBT*1*25
  1. .S DED=DED+$$GET1^DIQ(392,DGBTDT,9)
  1. .S TRIPTYP=+$$GET1^DIQ(392,DGBTDT,31,"I")
  1. .S TRIPS(TRIPTYP)=TRIPS(TRIPTYP)+1
  1. .S TRIPCT=TRIPCT+TRIPTYP
  1. .I ($G(CHZFLG))&(DGBTDT=DGBTDTI) S FUTURE=FUTURE+TRIPTYP,FDED=FDED+$$GET1^DIQ(392,DGBTDT,9,"I") ;*30 modified check to use date/time
  1. Q TRIPCT_U_TRIPS(1)_U_TRIPS(2)_U_DED_U
  1. WAIVYN() ;
  1. I DED'<18 Q "1^DED^"
  1. I TRIPCT>6 Q "1^TRIPS^"
  1. I '$D(DGBTINCA) N DGBTINCA,DGBTERR D GA^DGBTUTL(DFN,"DGBTINCA",DGBTDTI)
  1. I DGBTINCA Q "1^ALTINC^"
  1. I $$MANRQ Q "1^MAN^"_EXPDT
  1. I '$D(VAEL) N VAEL,VAERR D ELIG^VADPT
  1. I $$PENSION Q "1^PENSION^"
  1. ;I '$D(DGBTDEP) N DGBTDEP S DGBTDEP=$$DEP^VAFMON(DFN,DGBTDTI)
  1. ;I '$D(DGBTNSC) N DGBTNSC S DGBTNSC=$$NSC^DGBTUTL
  1. ;I '$D(DGBTINC) N DGBTINC S DGBTINC=$$INCOME^VAFMON(DFN,DGBTDTI,1)
  1. ;I '$D(DGBTMTTH) N DGBTMTTH S DGBTMTTH=$$MTTH^DGBTMTTH(DGBTDEP,DGBTDTI)
  1. ;I (DGBTNSC)&(+$TR($P(DGBTINC,U),"$,","")<DGBTRXTH) Q "1^NSC^"
  1. ;I '(DGBTNSC)&(+$G(VAEL(3)))&(+$TR($P(DGBTINC,U),"$,","")<DGBTMTTH) Q "1^LI^"
  1. ;I '(DGBTNSC),+$$LI^DGBTUTL(DFN,DGBTDTI,DGBTDEP,,DGBTINCA)'=0 Q "1^LI^"
  1. Q 0_"^^"
  1. MANRQ() ; Manual waiver request
  1. I '$D(^DGBT(392.7,"C",DFN)) Q 0_"^"
  1. N STDT
  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 STDT=$$GET1^DIQ(392.7,I,.01,"I")
  1. .I STDT>DGBTDTI S DGBTDW=0 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(DGBTDTI,1,3) S DGBTDW=^DGBT(392.7,I,0) Q
  1. .I $E(I,1,3)'=($E(DGBTDTI,1,3)-1) Q ;*38 - changed variable to DGBTDTI to prevent undefined error when called via rpc
  1. .I $$GET1^DIQ(392.7,I,8,"I")<$P(DGBTDTI,".") Q
  1. .S DGBTDW=^DGBT(392.7,I,0)
  1. I DGBTDW="" Q 0
  1. I $$GET1^DIQ(392.7,I,3)="NO" Q 0
  1. I $G(EXPDT)="PENSION" Q 1
  1. I $P(DGBTDTI,".")<$P($P(DGBTDW,U),".") Q 0
  1. I $G(EXPDT)?7N S EXPDT=$$DTFORM^DGBT1(EXPDT)
  1. Q DGBTDW
  1. PENSION() ;
  1. I '$D(VAEL) N VAEL,VAERR D ELIG^VADPT
  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