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 Oct 16, 2024@17:42:01 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)
