- DGBTUTL1 ;PAV - BENEFICIARY/TRAVEL UTILITY ROUTINES ; 11/14/11
- ;;1.0;Beneficiary Travel;**20,24,39**;September 25, 2001;Build 6
- ;;Reference to ADD^VADPT supported by ICR #10061
- ELIG(DFN) ;***PAVEL
- ;IBARXEU1 = DBIA1046
- ;DFN - Patient IEN
- ;The BT System must correctly determine if a veteran is eligible for BT reimbursement.
- ;There are several checks that the BT System must be modified to automatically make
- ;when determin;ing a veteran's eligibility, as well as several checks that require input from the user.
- ;When the BT user starts a claim, the BT System must be modified to perform the following checks automatically:
- D SETC ;Setting entries in file 492.41
- N VAEL,DGBTX D ELIG^VADPT
- S DGBTX=0
- ;a) If the veteran is Service Connected 30% or greater they are eligible for BT reimbursement.
- I $G(VAEL(3)),$P(VAEL(3),U,2)>29 D QUALQUES Q $S($G(DGBTELL)=14:$P($T(BTC+14),";;",2),$G(DGBTELL)=15:$P($T(BTC+15),";;",2),1:$P($T(BTC+1),";;",2)) ;"1^SC 30% or greater"
- I $P(DGBTINC,U,2)="H" D QUALQUES Q $S($G(DGBTELL)=14:$P($T(BTC+14),";;",2),$G(DGBTELL)=15:$P($T(BTC+15),";;",2),1:$P($T(BTC+18),";;",2))
- I $P(DGBTINC,U,2)="P" D QUALQUES Q $S($G(DGBTELL)=14:$P($T(BTC+14),";;",2),$G(DGBTELL)=15:$P($T(BTC+15),";;",2),1:$P($T(BTC+19),";;",2))
- ;b) If the veteran receives a VA pension they are eligible for BT reimbursement.
- I $$WVELG^DGBT1 D QUALQUES Q $S($G(DGBTELL)=14:$P($T(BTC+14),";;",2),$G(DGBTELL)=15:$P($T(BTC+15),";;",2),1:$P($T(BTC+2),";;",2)) ;"2^Recipient of VA Pension"
- I '$G(DGBTREF)&(DGBTNSC)&($P(DGBTINC,"^",1)'="")&(+$TR($P(DGBTINC,U),"$,","")<DGBTRXTH)&(DGBTDYFL) D QUALQUES Q $S($G(DGBTELL)=14:$P($T(BTC+14),";;",2),$G(DGBTELL)=15:$P($T(BTC+15),";;",2),1:$P($T(BTC+16),";;",2))
- I '$G(DGBTREF)&(+$P($G(VAEL(3)),U)&(+$P($G(VAEL(3)),U,2)<30)) D I $G(DGBTX) Q $S($G(DGBTELL)=14:$P($T(BTC+14),";;",2),$G(DGBTELL)=15:$P($T(BTC+15),";;",2),1:$P($T(BTC+17),";;",2))
- .I ($P(DGBTINC,"^",1)'="")&(+$TR($P(DGBTINC,U),"$,","")<DGBTRXTH)&('DGBTNSC)&(DGBTDYFL) S DGBTX=$T D QUALQUES
- N VAMB D MB^VADPT
- I VAMB(4) D QUALQUES Q $S($G(DGBTELL)=14:$P($T(BTC+14),";;",2),$G(DGBTELL)=15:$P($T(BTC+15),";;",2),1:$P($T(BTC+2),";;",2)) ;"2^Recipient of VA Pension"
- ;c) If the veteran is below the Low Income Eligibility thresholds based upon his current Means Test or Rx Co-pay test
- ; they are eligible for BT reimbursement.
- N XX,LI
- S LI="0^"
- I 'DGBTREF&($P(DGBTINC,"^",1)'="") S LI=$$LI^DGBTUTL(DFN,DGBTDTI,DGBTDEP,,DGBTINCA)
- I LI D QUALQUES S XX=$S(+LI:$P($T(BTC+(LI+2)),";;",2),$G(DGBTELL)=14:$P($T(BTC+14),";;",2),$G(DGBTELL)=15:$P($T(BTC+15),";;",2),1:0) Q:XX XX
- ;$G(DGBTELL)=14:$P($T(BTC+14),";;",2),$G(DGBTELL)=15:$P($T(BTC+15),";;",2),1:
- ;
- ;d) The. Service Connected (SC) appointment. If it can be determined that the veteran is travelling for a SC appointment
- ; then they are eligible for BT reimbursement. NOTE: the data in PCE may not always be complete. If BT is unable
- ; to automatically determine if the travel is SC related then BT may need to ask the user to perform this step manually (see step f).
- ;e) The BT System must check the PCE System in VistA to see if the patient is travelling for a Comp and Pension (C&P) appointment.
- ; If it can be determined that the veteran is travelling for a C&P appointment then they are eligible for BT reimbursement.
- ; NOTE: the data in PCE may not always be complete. If BT is unable to automatically determine if the travel is C&P
- ; related then BT may need to ask the user to perform this step manually (see step g).
- ;
- PCE ; Patient Encounter
- N DGVAL,DGCBK,DGDT1,DGQUERY,SDOE0,SDSTOP
- ;
- ;S DGVAL("DFN")=DFN,DGVAL("BDT")=DGBTDTI\1,DGVAL("EDT")=DGVAL("BDT")_".9999"
- ;S DGCBK="I $P(SDOE0,U,8)=2 D VIS^DGBTUTL1(SDOE0) S DGDT1=+SDOE0",DGDT1=""
- ;S XX=0 ;D SCAN^DGSDU("PATIENT/DATE",.DGVAL,"",DGCBK,1,.DGQUERY)
- ;Q:XX XX ;XX="7^Service connected appointment on the file"
- ;XX="8^Compensation & Pension appointment on the file"
- ;
- ;If any of the above automatic checks (a, b, c, d or e) indicate that the veteran is eligible for BT reimbursement
- ;then the processing for this enhancement is complete. If, however, the veteran does not pass any of the tests
- ;outlined above, the BT System must ask the user for additional information in order to determine if the veteran
- ;is eligible for BT reimbursement:
- ;
- ;f) The BT System must ask the user if the veteran is travelling for a SC appointment.
- ; If the user responds with YES then the veteran is eligible for BT reimbursement. Otherwise, go to step g.
- ;g) The BT System must ask the user if the veteran is travelling for a C&P appointment.
- ; If the user responds with YES then the veteran is eligible for BT reimbursement.
- ;
- ;DGBTSCAP - Contains answer to SC appointment question
- ;DGBTCPAP = Contains answer to C&P appointment question
- S DGBTSCAP=$$GET1^DIQ(392,DGBTDTI,43.4,"I")
- S DGBTCPAP=$$GET1^DIQ(392,DGBTDTI,43,"I")
- I '$G(DGBTNSC) W !,"IS THIS A CLAIM FOR A SERVICE CONNECTED APPOINTMENT" S %=$S('DGBTSCAP:2,1:1) D YN^DICN S DGBTSCAP=$S(%=2:"NO",1:"YES") I %'=2 D CLRLTR^DGBTDLT(0)
- I '$G(DGBTNSC) Q:%=1 $P($T(BTC+9),";;",2) ;"9^Patient stated SERVICE CONNECTED APPOINTMENT^43.1"
- I '$G(DGBTNSC) Q:%=-1 $P($T(BTC+14),";;",2) ;"14^Patient Exits Claim"
- W !,"IS THIS A CLAIM FOR A COMP AND PENSION APPOINTMENT" S %=$S('DGBTCPAP:2,1:1) D YN^DICN S DGBTCPAP=$S(%=2:"NO",1:"YES") I %'=2 D CLRLTR^DGBTDLT(0)
- Q:%=1 $P($T(BTC+10),";;",2) ;"10^Patient stated COMP AND PENSION APPOINTMENT"
- Q:%=-1 $P($T(BTC+14),";;",2) ;"14^Patient Exits Claim"
- W !!,"PATIENT IS NOT ELIGIBLE FOR BT REIMBURSEMENT"
- W !!,"CONTINUE WITH CLAIM" S %=2 D YN^DICN
- I %=2!('%) S DGBTAPPTYP=1 Q $P($T(BTC+15),";;",2) ;"15^PATIENT AGREES WITH DENIAL OF CLAIM" ;<== Here we should plug E11 Patient stated that he doesn' want to continue with claim
- D CLRLTR^DGBTDLT(0)
- Q:%=-1 $P($T(BTC+14),";;",2) ;"14^Patient Exits Claim"
- K DIR S DIR("A")="SELECT REASON FOR ELIGIBILITY: ",DIR(0)="SA^1:Caregiver;2:Transplant;3:Other" D ^DIR
- Q:Y=U $P($T(BTC+14),";;",2) ;"14^Patient Exits Claim"
- Q:Y=1 $P($T(BTC+11),";;",2) ;"11^PATIENT STATED ELIGIBILITY REASON Caregiver "
- Q:Y=2 $P($T(BTC+12),";;",2) ;"12^PATIENT STATED ELIGIBILITY REASON Transplant"
- ; Here assuming that Y=3
- K DIR S DIR("A")="SPECIFY OTHER REASON FOR ELIGIBILITY",DIR(0)="F" D ^DIR
- Q:Y=U $P($T(BTC+14),";;",2) ;"14^Patient Exits Claim"
- Q $P($T(BTC+13),";;",2)_": "_Y ;"13^PATIENT STATED OTHER REASON FOR ELIGIBILITY: "_Y
- ;
- ;If any of the above manual checks (f or g) indicate that the veteran is eligible for BT reimbursement then
- ;the processing for this enhancement is complete. If, however, the veteran does not pass any of the manual tests outlined above,
- ;the BT System must inform the user that the veteran does not qualify for BT reimbursement.
- ;The BT System must then ask the user if they want to continue with the claim anyway.
- ;If the user responds with NO then the claim is denied and the enhancement is complete.
- ;NOTE: at this point in the processing the BT application must Auto-generate BT Denial-of-Benefits Statement and
- ;Appellate Rights (see section 2.6.11)
- EXIT ;
- Q
- VIS(DGBTCSN) ;
- Q
- S:$S('DGDT1:0,1:+SDOE0'=DGDT1) SDSTOP=1
- I 'SDSTOP D
- .N DGBTCS,YY
- .S:$P(DGBTCSN,U,3) DGBTCS=$P(DGBTCSN,U,3)
- .S YY=$$GET1^DIQ(409.1,$P(DGBTCSN,"^",10)_",",4)
- .S:YY="SC" XX=$P($T(BTC+7),";;",2) ;"7^Service connected appointment on the file"
- .S:YY="CP" XX=$P($T(BTC+8),";;",2) ;"8^Compensation & Pension appointment on the file"
- Q
- BTC ; List of entries in 392.41 file
- ;;1^SC 30% or greater
- ;;2^Recipient of VA Pension
- ;;3^Low Income Copay
- ;;4^Low Income M Test
- ;;5^Alt. Income POW
- ;;6^Alt.Income Hardship
- ;;7^Service connected appointment on the file
- ;;8^Compensation & Pension appointment on the file
- ;;9^Patient stated SERVICE CONNECTED APPOINTMENT
- ;;10^Patient stated COMP AND PENSION APPOINTMENT
- ;;11^PATIENT STATED ELIGIBILITY REASON Caregiver
- ;;12^PATIENT STATED ELIGIBILITY REASON Transplant
- ;;13^PATIENT STATED OTHER REASON FOR ELIGIBILITY
- ;;14^""
- ;;15^CLAIM DENIED
- ;;16^NSC Low Income
- ;;17^SC Under 30% and Low Income
- ;;18^Alternate Income Hardship
- ;;19^Alternate Income POW
- ;;20^Patient stated QUALIFIED SC APPOINTMENT
- ;;21^Patient refuse to provide financial information
- ;;END
- Q
- SETC ;Set entries into 392.41 if these are not there
- N II,FDA,IENC
- F II=1:1 S IENC(1)=+$P($T(BTC+II),";;",2) Q:'IENC(1) S FDA(392.41,"+1,",.01)=IENC(1),FDA(392.41,"+1,",1)=$P($T(BTC+II),"^",2) D UPDATE^DIE(,"FDA","IENC")
- Q
- KILLC ;Remove all entries from 392.41
- N DA,DIK S DA=0,DIK="^DGBT(392.41," F S DA=$O(^DGBT(392.41,DA)) Q:'DA D ^DIK
- Q
- ;
- QUALQUES ;this will ask if the appointment was a qualified appointment if the patient is SC 30% or greater
- ;
- ;DGBTQAP - Contains answer for Qualified Appointment question
- S DGBTQAP=$$GET1^DIQ(392,DGBTDTI,43.5,"I")
- W !!,"Answer NO if you want to deny claim for any reason. Want to continue" S %=$S('$G(DGBTQAP):1,1:$G(DGBTQAP)) D YN^DICN S DGBTQAP=$S(%=2:"NO",1:"YES") I %'=2 D CLRLTR^DGBTDLT(0)
- I %=2 S DGBTELL=15,LI="" ;$P($T(BTC+9),";;",2) ;"20^Patient stated QUALIFIED SC APPOINTMENT^43.1"
- I %'=2 D CLRLTR^DGBTDLT(0)
- I %=-1 S DGBTELL=14
- ;
- Q
- ;
- MTCHK(DFN,DGBTDTI) ;
- N VFADT,RESULT,MTIEN,MTDATA,ERR,DGBTMT,VFADAYS,MTDAYS,DGDONE,DGMTST,DGIEN
- ;
- S (DGDONE,RESULT)=0
- ;
- S MTIEN=+$$LST^DGMTCOU1(DFN,$P(DGBTDTI,".",1),1)
- I '$G(MTIEN) Q 0
- D GETS^DIQ(408.31,MTIEN_",",".01;.03;.27;.11;.14;.12;.07","IE","MTDATA","ERR")
- M DGBTMT=MTDATA(408.31,MTIEN_",")
- ;
- S VFADT=$$GET1^DIQ(43,"1,",1205,"I",,"ERR")
- I '$G(VFADT) Q -1
- ;
- ; Decision Rule 6
- I +DGBTMT(.01,"I")>DT G MTQ
- ;
- ; Decision Rule 1
- S MTDAYS=$$FMADD^XLFDT(+DGBTMT(.01,"I"),365,0,0,0)
- I MTDAYS'<VFADT D I +$G(DGDONE) G MTQ ; Quit on meeting conditions
- . I +DGBTMT(.07,"I")>0 S (DGDONE,RESULT)=1
- ;
- ; Decision Rule 2
- I +DGBTMT(.01,"I")>VFADT D I +$G(DGDONE) G MTQ ; Quit on meeting conditions
- . I +DGBTMT(.07,"I")>0 S (DGDONE,RESULT)=1
- ;
- S DGMTST=$O(^DG(408.32,"B","MT COPAY REQUIRED",0))
- ; Decision Rule 3
- I +DGBTMT(.03,"I")=DGMTST D I +$G(DGDONE) G MTQ ; Quit on meeting conditions
- . I DGBTMT(.07,"I")'<2991006 D
- .. I +DGBTMT(.11,"I") S (DGDONE,RESULT)=1
- ;
- ; Decision Rule 4
- I +DGBTMT(.03,"I")=DGMTST D I +$G(DGDONE) G MTQ ; Quit on meeting conditions
- . I +DGBTMT(.11,"I") D
- .. I +DGBTMT(.14,"I") S (DGDONE,RESULT)=1
- ;
- ; Decision Rule 5
- I DGBTMT(.03,"E")["PENDING" D
- . I +DGBTMT(.27,"I")'>+DGBTMT(.12,"I") D
- .. I DGBTMT(.07,"I")'<2991006 D
- ... I +DGBTMT(.11,"I") D
- .... I DGBTMT(.14,"I")=0 S RESULT=1
- ;
- MTQ ;
- Q RESULT
- ;
- RESADDR(DGBTADDR) ;dgbt*1.0*39 - residential address
- ;This api was created to utilize the Veteran's residential address.
- ;If no residential address exists, default to the mailing address.
- ;
- ;DGBTADDR array
- ; (1) - street address 1
- ; (2) - street address 2
- ; (3) - street address 3
- ; (4) - city
- ; (5) - state
- ; (6) - zip code internal^external format
- ; (7) - county
- ;
- N X ;preserve value of x prior to vadpt call
- I $G(DFN) D ADD^VADPT D ;ICR #10061
- . I $D(VAPA(30)) D Q ;if residential street address 1, vapa(30), is defined then must have city and zip
- .. ;set residential address components
- .. S DGBTADDR(1)=$G(VAPA(30)) ;residential street address 1
- .. S DGBTADDR(2)=$G(VAPA(31)) ;residential street address 2
- .. S DGBTADDR(3)=$G(VAPA(32)) ;residential street address 3
- .. S DGBTADDR(4)=$G(VAPA(33)) ;residential city - required if residential street address 1, vapa(30), defined
- .. S DGBTADDR(5)=$G(VAPA(34)) ;residential state internal^external format.(e.g., 6^CALIFORNIA)
- .. I $D(VAPA(35)) D ;residential zip code
- ... ;set nine or five digit zip code internal^external format (e.g. 123454444^12345-4444)
- ... I $L($G(VAPA(35)))>5&($G(VAPA(35))?9N) S DGBTADDR(6)=VAPA(35)_"^"_$E(VAPA(35),1,5)_"-"_$E(VAPA(35),6,9) Q
- ... S DGBTADDR(6)=$G(VAPA(35))_"^"_$G(VAPA(35)) Q ;five digit zip code
- .. S DGBTADDR(7)=$G(VAPA(36)) ;residential county internal^external format.(e.g., 1^ALAMEDA)
- . ;
- . Q:$G(DGBTRES) ;when called from bt dashboard only use residential address
- . ;
- . ;default to mailing address components if no residential address
- . S DGBTADDR(1)=$G(VAPA(1)) ;mailing street address 1
- . S DGBTADDR(2)=$G(VAPA(2)) ;mailing street address 2
- . S DGBTADDR(3)=$G(VAPA(3)) ;mailing street address 3
- . S DGBTADDR(4)=$G(VAPA(4)) ;mailing city
- . S DGBTADDR(5)=$G(VAPA(5)) ;mailing state internal^external format.(e.g., 6^CALIFORNIA)
- . S DGBTADDR(6)=$G(VAPA(11)) ;mailing zip code internal^external format (e.g. 123454444^12345-4444)
- . S DGBTADDR(7)=$G(VAPA(7)) ;mailing county internal^external format.(e.g., 1^ALAMEDA)
- . Q
- Q
- ;
- DASHADDR(DFN) ;dgbt*1.0*39 - function to pull the address for the bt dashboard patient class
- Q:'$G(DFN)
- N DGBTRES,DGBTARY
- S DGBTRES=1
- D RESADDR(.DGBTARY)
- ;format - street address 1^street address 2^street address 3^city^internal state^external state^five-digit zipcode
- Q $G(DGBTARY(1))_"^"_$G(DGBTARY(2))_"^"_$G(DGBTARY(3))_"^"_$G(DGBTARY(4))_"^"_$G(DGBTARY(5))_"^"_$P($P($G(DGBTARY(6)),"-"),"^",2)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTUTL1 13295 printed Feb 18, 2025@23:07:32 Page 2
- DGBTUTL1 ;PAV - BENEFICIARY/TRAVEL UTILITY ROUTINES ; 11/14/11
- +1 ;;1.0;Beneficiary Travel;**20,24,39**;September 25, 2001;Build 6
- +2 ;;Reference to ADD^VADPT supported by ICR #10061
- ELIG(DFN) ;***PAVEL
- +1 ;IBARXEU1 = DBIA1046
- +2 ;DFN - Patient IEN
- +3 ;The BT System must correctly determine if a veteran is eligible for BT reimbursement.
- +4 ;There are several checks that the BT System must be modified to automatically make
- +5 ;when determin;ing a veteran's eligibility, as well as several checks that require input from the user.
- +6 ;When the BT user starts a claim, the BT System must be modified to perform the following checks automatically:
- +7 ;Setting entries in file 492.41
- DO SETC
- +8 NEW VAEL,DGBTX
- DO ELIG^VADPT
- +9 SET DGBTX=0
- +10 ;a) If the veteran is Service Connected 30% or greater they are eligible for BT reimbursement.
- +11 ;"1^SC 30% or greater"
- IF $GET(VAEL(3))
- IF $PIECE(VAEL(3),U,2)>29
- DO QUALQUES
- QUIT $SELECT($GET(DGBTELL)=14:$PIECE($TEXT(BTC+14),";;",2),$GET(DGBTELL)=15:$PIECE($TEXT(BTC+15),";;",2),1:$PIECE($TEXT(BTC+1),";;",2))
- +12 IF $PIECE(DGBTINC,U,2)="H"
- DO QUALQUES
- QUIT $SELECT($GET(DGBTELL)=14:$PIECE($TEXT(BTC+14),";;",2),$GET(DGBTELL)=15:$PIECE($TEXT(BTC+15),";;",2),1:$PIECE($TEXT(BTC+18),";;",2))
- +13 IF $PIECE(DGBTINC,U,2)="P"
- DO QUALQUES
- QUIT $SELECT($GET(DGBTELL)=14:$PIECE($TEXT(BTC+14),";;",2),$GET(DGBTELL)=15:$PIECE($TEXT(BTC+15),";;",2),1:$PIECE($TEXT(BTC+19),";;",2))
- +14 ;b) If the veteran receives a VA pension they are eligible for BT reimbursement.
- +15 ;"2^Recipient of VA Pension"
- IF $$WVELG^DGBT1
- DO QUALQUES
- QUIT $SELECT($GET(DGBTELL)=14:$PIECE($TEXT(BTC+14),";;",2),$GET(DGBTELL)=15:$PIECE($TEXT(BTC+15),";;",2),1:$PIECE($TEXT(BTC+2),";;",2))
- +16 IF '$GET(DGBTREF)&(DGBTNSC)&($PIECE(DGBTINC,"^",1)'="")&(+$TRANSLATE($PIECE(DGBTINC,U),"$,","")<DGBTRXTH)&(DGBTDYFL)
- DO QUALQUES
- QUIT $SELECT($GET(DGBTELL)=14:$PIECE($TEXT(BTC+14),";;",2),$GET(DGBTELL)=15:$PIECE($TEXT(BTC+15),";;",2),1:$PIECE($TEXT(BTC+16),";;",2))
- +17 IF '$GET(DGBTREF)&(+$PIECE($GET(VAEL(3)),U)&(+$PIECE($GET(VAEL(3)),U,2)<30))
- Begin DoDot:1
- +18 IF ($PIECE(DGBTINC,"^",1)'="")&(+$TRANSLATE($PIECE(DGBTINC,U),"$,","")<DGBTRXTH)&('DGBTNSC)&(DGBTDYFL)
- SET DGBTX=$TEST
- DO QUALQUES
- End DoDot:1
- IF $GET(DGBTX)
- QUIT $SELECT($GET(DGBTELL)=14:$PIECE($TEXT(BTC+14),";;",2),$GET(DGBTELL)=15:$PIECE($TEXT(BTC+15),";;",2),1:$PIECE($TEXT(BTC+17),";;",2))
- +19 NEW VAMB
- DO MB^VADPT
- +20 ;"2^Recipient of VA Pension"
- IF VAMB(4)
- DO QUALQUES
- QUIT $SELECT($GET(DGBTELL)=14:$PIECE($TEXT(BTC+14),";;",2),$GET(DGBTELL)=15:$PIECE($TEXT(BTC+15),";;",2),1:$PIECE($TEXT(BTC+2),";;",2))
- +21 ;c) If the veteran is below the Low Income Eligibility thresholds based upon his current Means Test or Rx Co-pay test
- +22 ; they are eligible for BT reimbursement.
- +23 NEW XX,LI
- +24 SET LI="0^"
- +25 IF 'DGBTREF&($PIECE(DGBTINC,"^",1)'="")
- SET LI=$$LI^DGBTUTL(DFN,DGBTDTI,DGBTDEP,,DGBTINCA)
- +26 IF LI
- DO QUALQUES
- SET XX=$SELECT(+LI:$PIECE($TEXT(BTC+(LI+2)),";;",2),$GET(DGBTELL)=14:$PIECE($TEXT(BTC+14),";;",2),$GET(DGBTELL)=15:$PIECE($TEXT(BTC+15),";;",2),1:0)
- if XX
- QUIT XX
- +27 ;$G(DGBTELL)=14:$P($T(BTC+14),";;",2),$G(DGBTELL)=15:$P($T(BTC+15),";;",2),1:
- +28 ;
- +29 ;d) The. Service Connected (SC) appointment. If it can be determined that the veteran is travelling for a SC appointment
- +30 ; then they are eligible for BT reimbursement. NOTE: the data in PCE may not always be complete. If BT is unable
- +31 ; to automatically determine if the travel is SC related then BT may need to ask the user to perform this step manually (see step f).
- +32 ;e) The BT System must check the PCE System in VistA to see if the patient is travelling for a Comp and Pension (C&P) appointment.
- +33 ; If it can be determined that the veteran is travelling for a C&P appointment then they are eligible for BT reimbursement.
- +34 ; NOTE: the data in PCE may not always be complete. If BT is unable to automatically determine if the travel is C&P
- +35 ; related then BT may need to ask the user to perform this step manually (see step g).
- +36 ;
- PCE ; Patient Encounter
- +1 NEW DGVAL,DGCBK,DGDT1,DGQUERY,SDOE0,SDSTOP
- +2 ;
- +3 ;S DGVAL("DFN")=DFN,DGVAL("BDT")=DGBTDTI\1,DGVAL("EDT")=DGVAL("BDT")_".9999"
- +4 ;S DGCBK="I $P(SDOE0,U,8)=2 D VIS^DGBTUTL1(SDOE0) S DGDT1=+SDOE0",DGDT1=""
- +5 ;S XX=0 ;D SCAN^DGSDU("PATIENT/DATE",.DGVAL,"",DGCBK,1,.DGQUERY)
- +6 ;Q:XX XX ;XX="7^Service connected appointment on the file"
- +7 ;XX="8^Compensation & Pension appointment on the file"
- +8 ;
- +9 ;If any of the above automatic checks (a, b, c, d or e) indicate that the veteran is eligible for BT reimbursement
- +10 ;then the processing for this enhancement is complete. If, however, the veteran does not pass any of the tests
- +11 ;outlined above, the BT System must ask the user for additional information in order to determine if the veteran
- +12 ;is eligible for BT reimbursement:
- +13 ;
- +14 ;f) The BT System must ask the user if the veteran is travelling for a SC appointment.
- +15 ; If the user responds with YES then the veteran is eligible for BT reimbursement. Otherwise, go to step g.
- +16 ;g) The BT System must ask the user if the veteran is travelling for a C&P appointment.
- +17 ; If the user responds with YES then the veteran is eligible for BT reimbursement.
- +18 ;
- +19 ;DGBTSCAP - Contains answer to SC appointment question
- +20 ;DGBTCPAP = Contains answer to C&P appointment question
- +21 SET DGBTSCAP=$$GET1^DIQ(392,DGBTDTI,43.4,"I")
- +22 SET DGBTCPAP=$$GET1^DIQ(392,DGBTDTI,43,"I")
- +23 IF '$GET(DGBTNSC)
- WRITE !,"IS THIS A CLAIM FOR A SERVICE CONNECTED APPOINTMENT"
- SET %=$SELECT('DGBTSCAP:2,1:1)
- DO YN^DICN
- SET DGBTSCAP=$SELECT(%=2:"NO",1:"YES")
- IF %'=2
- DO CLRLTR^DGBTDLT(0)
- +24 ;"9^Patient stated SERVICE CONNECTED APPOINTMENT^43.1"
- IF '$GET(DGBTNSC)
- if %=1
- QUIT $PIECE($TEXT(BTC+9),";;",2)
- +25 ;"14^Patient Exits Claim"
- IF '$GET(DGBTNSC)
- if %=-1
- QUIT $PIECE($TEXT(BTC+14),";;",2)
- +26 WRITE !,"IS THIS A CLAIM FOR A COMP AND PENSION APPOINTMENT"
- SET %=$SELECT('DGBTCPAP:2,1:1)
- DO YN^DICN
- SET DGBTCPAP=$SELECT(%=2:"NO",1:"YES")
- IF %'=2
- DO CLRLTR^DGBTDLT(0)
- +27 ;"10^Patient stated COMP AND PENSION APPOINTMENT"
- if %=1
- QUIT $PIECE($TEXT(BTC+10),";;",2)
- +28 ;"14^Patient Exits Claim"
- if %=-1
- QUIT $PIECE($TEXT(BTC+14),";;",2)
- +29 WRITE !!,"PATIENT IS NOT ELIGIBLE FOR BT REIMBURSEMENT"
- +30 WRITE !!,"CONTINUE WITH CLAIM"
- SET %=2
- DO YN^DICN
- +31 ;"15^PATIENT AGREES WITH DENIAL OF CLAIM" ;<== Here we should plug E11 Patient stated that he doesn' want to continue with claim
- IF %=2!('%)
- SET DGBTAPPTYP=1
- QUIT $PIECE($TEXT(BTC+15),";;",2)
- +32 DO CLRLTR^DGBTDLT(0)
- +33 ;"14^Patient Exits Claim"
- if %=-1
- QUIT $PIECE($TEXT(BTC+14),";;",2)
- +34 KILL DIR
- SET DIR("A")="SELECT REASON FOR ELIGIBILITY: "
- SET DIR(0)="SA^1:Caregiver;2:Transplant;3:Other"
- DO ^DIR
- +35 ;"14^Patient Exits Claim"
- if Y=U
- QUIT $PIECE($TEXT(BTC+14),";;",2)
- +36 ;"11^PATIENT STATED ELIGIBILITY REASON Caregiver "
- if Y=1
- QUIT $PIECE($TEXT(BTC+11),";;",2)
- +37 ;"12^PATIENT STATED ELIGIBILITY REASON Transplant"
- if Y=2
- QUIT $PIECE($TEXT(BTC+12),";;",2)
- +38 ; Here assuming that Y=3
- +39 KILL DIR
- SET DIR("A")="SPECIFY OTHER REASON FOR ELIGIBILITY"
- SET DIR(0)="F"
- DO ^DIR
- +40 ;"14^Patient Exits Claim"
- if Y=U
- QUIT $PIECE($TEXT(BTC+14),";;",2)
- +41 ;"13^PATIENT STATED OTHER REASON FOR ELIGIBILITY: "_Y
- QUIT $PIECE($TEXT(BTC+13),";;",2)_": "_Y
- +42 ;
- +43 ;If any of the above manual checks (f or g) indicate that the veteran is eligible for BT reimbursement then
- +44 ;the processing for this enhancement is complete. If, however, the veteran does not pass any of the manual tests outlined above,
- +45 ;the BT System must inform the user that the veteran does not qualify for BT reimbursement.
- +46 ;The BT System must then ask the user if they want to continue with the claim anyway.
- +47 ;If the user responds with NO then the claim is denied and the enhancement is complete.
- +48 ;NOTE: at this point in the processing the BT application must Auto-generate BT Denial-of-Benefits Statement and
- +49 ;Appellate Rights (see section 2.6.11)
- EXIT ;
- +1 QUIT
- VIS(DGBTCSN) ;
- +1 QUIT
- +2 if $SELECT('DGDT1
- SET SDSTOP=1
- +3 IF 'SDSTOP
- Begin DoDot:1
- +4 NEW DGBTCS,YY
- +5 if $PIECE(DGBTCSN,U,3)
- SET DGBTCS=$PIECE(DGBTCSN,U,3)
- +6 SET YY=$$GET1^DIQ(409.1,$PIECE(DGBTCSN,"^",10)_",",4)
- +7 ;"7^Service connected appointment on the file"
- if YY="SC"
- SET XX=$PIECE($TEXT(BTC+7),";;",2)
- +8 ;"8^Compensation & Pension appointment on the file"
- if YY="CP"
- SET XX=$PIECE($TEXT(BTC+8),";;",2)
- End DoDot:1
- +9 QUIT
- BTC ; List of entries in 392.41 file
- +1 ;;1^SC 30% or greater
- +2 ;;2^Recipient of VA Pension
- +3 ;;3^Low Income Copay
- +4 ;;4^Low Income M Test
- +5 ;;5^Alt. Income POW
- +6 ;;6^Alt.Income Hardship
- +7 ;;7^Service connected appointment on the file
- +8 ;;8^Compensation & Pension appointment on the file
- +9 ;;9^Patient stated SERVICE CONNECTED APPOINTMENT
- +10 ;;10^Patient stated COMP AND PENSION APPOINTMENT
- +11 ;;11^PATIENT STATED ELIGIBILITY REASON Caregiver
- +12 ;;12^PATIENT STATED ELIGIBILITY REASON Transplant
- +13 ;;13^PATIENT STATED OTHER REASON FOR ELIGIBILITY
- +14 ;;14^""
- +15 ;;15^CLAIM DENIED
- +16 ;;16^NSC Low Income
- +17 ;;17^SC Under 30% and Low Income
- +18 ;;18^Alternate Income Hardship
- +19 ;;19^Alternate Income POW
- +20 ;;20^Patient stated QUALIFIED SC APPOINTMENT
- +21 ;;21^Patient refuse to provide financial information
- +22 ;;END
- +23 QUIT
- SETC ;Set entries into 392.41 if these are not there
- +1 NEW II,FDA,IENC
- +2 FOR II=1:1
- SET IENC(1)=+$PIECE($TEXT(BTC+II),";;",2)
- if 'IENC(1)
- QUIT
- SET FDA(392.41,"+1,",.01)=IENC(1)
- SET FDA(392.41,"+1,",1)=$PIECE($TEXT(BTC+II),"^",2)
- DO UPDATE^DIE(,"FDA","IENC")
- +3 QUIT
- KILLC ;Remove all entries from 392.41
- +1 NEW DA,DIK
- SET DA=0
- SET DIK="^DGBT(392.41,"
- FOR
- SET DA=$ORDER(^DGBT(392.41,DA))
- if 'DA
- QUIT
- DO ^DIK
- +2 QUIT
- +3 ;
- QUALQUES ;this will ask if the appointment was a qualified appointment if the patient is SC 30% or greater
- +1 ;
- +2 ;DGBTQAP - Contains answer for Qualified Appointment question
- +3 SET DGBTQAP=$$GET1^DIQ(392,DGBTDTI,43.5,"I")
- +4 WRITE !!,"Answer NO if you want to deny claim for any reason. Want to continue"
- SET %=$SELECT('$GET(DGBTQAP):1,1:$GET(DGBTQAP))
- DO YN^DICN
- SET DGBTQAP=$SELECT(%=2:"NO",1:"YES")
- IF %'=2
- DO CLRLTR^DGBTDLT(0)
- +5 ;$P($T(BTC+9),";;",2) ;"20^Patient stated QUALIFIED SC APPOINTMENT^43.1"
- IF %=2
- SET DGBTELL=15
- SET LI=""
- +6 IF %'=2
- DO CLRLTR^DGBTDLT(0)
- +7 IF %=-1
- SET DGBTELL=14
- +8 ;
- +9 QUIT
- +10 ;
- MTCHK(DFN,DGBTDTI) ;
- +1 NEW VFADT,RESULT,MTIEN,MTDATA,ERR,DGBTMT,VFADAYS,MTDAYS,DGDONE,DGMTST,DGIEN
- +2 ;
- +3 SET (DGDONE,RESULT)=0
- +4 ;
- +5 SET MTIEN=+$$LST^DGMTCOU1(DFN,$PIECE(DGBTDTI,".",1),1)
- +6 IF '$GET(MTIEN)
- QUIT 0
- +7 DO GETS^DIQ(408.31,MTIEN_",",".01;.03;.27;.11;.14;.12;.07","IE","MTDATA","ERR")
- +8 MERGE DGBTMT=MTDATA(408.31,MTIEN_",")
- +9 ;
- +10 SET VFADT=$$GET1^DIQ(43,"1,",1205,"I",,"ERR")
- +11 IF '$GET(VFADT)
- QUIT -1
- +12 ;
- +13 ; Decision Rule 6
- +14 IF +DGBTMT(.01,"I")>DT
- GOTO MTQ
- +15 ;
- +16 ; Decision Rule 1
- +17 SET MTDAYS=$$FMADD^XLFDT(+DGBTMT(.01,"I"),365,0,0,0)
- +18 ; Quit on meeting conditions
- IF MTDAYS'<VFADT
- Begin DoDot:1
- +19 IF +DGBTMT(.07,"I")>0
- SET (DGDONE,RESULT)=1
- End DoDot:1
- IF +$GET(DGDONE)
- GOTO MTQ
- +20 ;
- +21 ; Decision Rule 2
- +22 ; Quit on meeting conditions
- IF +DGBTMT(.01,"I")>VFADT
- Begin DoDot:1
- +23 IF +DGBTMT(.07,"I")>0
- SET (DGDONE,RESULT)=1
- End DoDot:1
- IF +$GET(DGDONE)
- GOTO MTQ
- +24 ;
- +25 SET DGMTST=$ORDER(^DG(408.32,"B","MT COPAY REQUIRED",0))
- +26 ; Decision Rule 3
- +27 ; Quit on meeting conditions
- IF +DGBTMT(.03,"I")=DGMTST
- Begin DoDot:1
- +28 IF DGBTMT(.07,"I")'<2991006
- Begin DoDot:2
- +29 IF +DGBTMT(.11,"I")
- SET (DGDONE,RESULT)=1
- End DoDot:2
- End DoDot:1
- IF +$GET(DGDONE)
- GOTO MTQ
- +30 ;
- +31 ; Decision Rule 4
- +32 ; Quit on meeting conditions
- IF +DGBTMT(.03,"I")=DGMTST
- Begin DoDot:1
- +33 IF +DGBTMT(.11,"I")
- Begin DoDot:2
- +34 IF +DGBTMT(.14,"I")
- SET (DGDONE,RESULT)=1
- End DoDot:2
- End DoDot:1
- IF +$GET(DGDONE)
- GOTO MTQ
- +35 ;
- +36 ; Decision Rule 5
- +37 IF DGBTMT(.03,"E")["PENDING"
- Begin DoDot:1
- +38 IF +DGBTMT(.27,"I")'>+DGBTMT(.12,"I")
- Begin DoDot:2
- +39 IF DGBTMT(.07,"I")'<2991006
- Begin DoDot:3
- +40 IF +DGBTMT(.11,"I")
- Begin DoDot:4
- +41 IF DGBTMT(.14,"I")=0
- SET RESULT=1
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +42 ;
- MTQ ;
- +1 QUIT RESULT
- +2 ;
- RESADDR(DGBTADDR) ;dgbt*1.0*39 - residential address
- +1 ;This api was created to utilize the Veteran's residential address.
- +2 ;If no residential address exists, default to the mailing address.
- +3 ;
- +4 ;DGBTADDR array
- +5 ; (1) - street address 1
- +6 ; (2) - street address 2
- +7 ; (3) - street address 3
- +8 ; (4) - city
- +9 ; (5) - state
- +10 ; (6) - zip code internal^external format
- +11 ; (7) - county
- +12 ;
- +13 ;preserve value of x prior to vadpt call
- NEW X
- +14 ;ICR #10061
- IF $GET(DFN)
- DO ADD^VADPT
- Begin DoDot:1
- +15 ;if residential street address 1, vapa(30), is defined then must have city and zip
- IF $DATA(VAPA(30))
- Begin DoDot:2
- +16 ;set residential address components
- +17 ;residential street address 1
- SET DGBTADDR(1)=$GET(VAPA(30))
- +18 ;residential street address 2
- SET DGBTADDR(2)=$GET(VAPA(31))
- +19 ;residential street address 3
- SET DGBTADDR(3)=$GET(VAPA(32))
- +20 ;residential city - required if residential street address 1, vapa(30), defined
- SET DGBTADDR(4)=$GET(VAPA(33))
- +21 ;residential state internal^external format.(e.g., 6^CALIFORNIA)
- SET DGBTADDR(5)=$GET(VAPA(34))
- +22 ;residential zip code
- IF $DATA(VAPA(35))
- Begin DoDot:3
- +23 ;set nine or five digit zip code internal^external format (e.g. 123454444^12345-4444)
- +24 IF $LENGTH($GET(VAPA(35)))>5&($GET(VAPA(35))?9N)
- SET DGBTADDR(6)=VAPA(35)_"^"_$EXTRACT(VAPA(35),1,5)_"-"_$EXTRACT(VAPA(35),6,9)
- QUIT
- +25 ;five digit zip code
- SET DGBTADDR(6)=$GET(VAPA(35))_"^"_$GET(VAPA(35))
- QUIT
- End DoDot:3
- +26 ;residential county internal^external format.(e.g., 1^ALAMEDA)
- SET DGBTADDR(7)=$GET(VAPA(36))
- End DoDot:2
- QUIT
- +27 ;
- +28 ;when called from bt dashboard only use residential address
- if $GET(DGBTRES)
- QUIT
- +29 ;
- +30 ;default to mailing address components if no residential address
- +31 ;mailing street address 1
- SET DGBTADDR(1)=$GET(VAPA(1))
- +32 ;mailing street address 2
- SET DGBTADDR(2)=$GET(VAPA(2))
- +33 ;mailing street address 3
- SET DGBTADDR(3)=$GET(VAPA(3))
- +34 ;mailing city
- SET DGBTADDR(4)=$GET(VAPA(4))
- +35 ;mailing state internal^external format.(e.g., 6^CALIFORNIA)
- SET DGBTADDR(5)=$GET(VAPA(5))
- +36 ;mailing zip code internal^external format (e.g. 123454444^12345-4444)
- SET DGBTADDR(6)=$GET(VAPA(11))
- +37 ;mailing county internal^external format.(e.g., 1^ALAMEDA)
- SET DGBTADDR(7)=$GET(VAPA(7))
- +38 QUIT
- End DoDot:1
- +39 QUIT
- +40 ;
- DASHADDR(DFN) ;dgbt*1.0*39 - function to pull the address for the bt dashboard patient class
- +1 if '$GET(DFN)
- QUIT
- +2 NEW DGBTRES,DGBTARY
- +3 SET DGBTRES=1
- +4 DO RESADDR(.DGBTARY)
- +5 ;format - street address 1^street address 2^street address 3^city^internal state^external state^five-digit zipcode
- +6 QUIT $GET(DGBTARY(1))_"^"_$GET(DGBTARY(2))_"^"_$GET(DGBTARY(3))_"^"_$GET(DGBTARY(4))_"^"_$GET(DGBTARY(5))_"^"_$PIECE($PIECE($GET(DGBTARY(6)),"-"),"^",2)