DGBTEE2 ;ALB/SCK - BENEFICIARY TRAVEL ENTER/EDIT CONT ; 03/23/93
;;1.0;Beneficiary Travel;**17,20,39**;September 25, 2001;Build 6
START ;
Q
STUFF ; stuff departure=home address, destination=division(ins) address, and attendant/payee=patient
S DGBTFR1=$S($G(CHZFLG):$P(DGBTVAR("D"),"^",1),1:DGBTADDR(1)),DGBTFR2=$S($G(CHZFLG):$P(DGBTVAR("D"),"^",2),1:DGBTADDR(2)),DGBTFR3=$S($G(CHZFLG):$P(DGBTVAR("D"),"^",3),1:DGBTADDR(3)),DGBTAP=VADM(1) ;*39 - updated to use residential address
;S DGBTFR1=$S('$G(CHZFLG):VAPA(1),1:$P(DGBTVAR("D"),"^",1)),DGBTFR2=$S('$G(CHZFLG):VAPA(2),1:$P(DGBTVAR("D"),"^",2)),DGBTFR3=$S('$G(CHZFLG):VAPA(3),1:$P(DGBTVAR("D"),"^",3)),DGBTAP=VADM(1)
; function call $$DEPCTY passes the zip code from the patient data, and returns with the departure city name or a null.
; if a null for the city is returned, the city name in the patient data is defaulted to.
I '$G(CHZFLG) S XX=$$DEPCTY^DGBTUTL($P(DGBTADDR(6),U)) S X=$S(+XX>0:$P(XX,U,2),1:DGBTADDR(4)) ;*39 - updated to use residential address
I $G(CHZFLG) S XX=$$DEPCTY^DGBTUTL($P(DGBTVAR("D"),"^",6)) S X=$S(+XX>0:$P(XX,U,2),1:$P(DGBTVAR("D"),"^",4))
D UP^DGBTHELP S DGBTFR4=X
K DGBTVAR(0) S DGBTVAR(0)=$S($D(^DGBT(392,DGBTDT,0)):^(0),1:"")
S (DGBTDIV,DGBTDV1)=$P(DGBTVAR(0),"^",11),DGBTTO1=$P(^DG(40.8,DGBTDIV,0),"^"),DGBTDIV=$P(^DG(40.8,DGBTDIV,0),"^",7)
S (DGBTTO2,DGBTTO3,DGBTTO4,X)=""
I ('$G(CHZFLG)&($D(^DIC(4,DGBTDIV,1))#10=1)) S DGBTTO2=$P(^DIC(4,DGBTDIV,1),"^"),DGBTTO3=$P(^(1),"^",2),X=$P(^(1),"^",3) D UP^DGBTHELP S DGBTTO4=X Q ; ref file #4, institution file by selected div
S DGBTTO1=$P(DGBTVAR("T"),U),DGBTTO2=$P(DGBTVAR("T"),U,2),DGBTTO3=$P(DGBTVAR("T"),U,3) ;RFE DGBT*1.0*20
S XX=$$DEPCTY^DGBTUTL($P(DGBTVAR("T"),"^",6)) S X=$S(+XX>0:$P(XX,U,2),1:$P(DGBTVAR("T"),"^",4)) ;RFE DGBT*1.0*20
D UP^DGBTHELP S DGBTTO4=X ;RFE DGBT*1.0*20
Q
DED ;
I $D(^DG(43.1,$O(^DG(43.1,(9999999.99999-DGBTDT))),"BT")) D
. S DGBTRATE=^("BT"),DGBTDPV=$P(DGBTRATE,"^"),DGBTDPM=$P(DGBTRATE,"^",2),DGBTMR=$P(DGBTRATE,"^",3) ; ref file #43, MAS parameters file for BT settings
.; DGBTDPV = DEDUCTIBLE/VISIT DGBTDPM = DEDUCTIBLE/MONTH DGBTMR = MILEAGE RATE DGBTDCM = Deductible paid for this month
I $D(^DGBT(392,DGBTDT,"M")) I $P(^("M"),"^")=1 S DGBTDPV=DGBTDPV/2 ; ref file #392, claims file.
S DGBTDRM=DGBTDPM-DGBTDCM ; Deductible to be paid
I DGBTDRM<0 S DGBTDRM=0
S DGBTDCV=0
I DGBTDCM'<DGBTDPM S DGBTDCV=0
I DGBTDRM'<DGBTDPV&(DGBTTC'<DGBTDPV) S DGBTDCV=DGBTDPV
I DGBTDRM'<DGBTDPV&(DGBTTC'>DGBTDPV) S DGBTDCV=DGBTTC
I DGBTDRM'>DGBTDPV&(DGBTTC'>DGBTDRM) S DGBTDCV=DGBTTC
I DGBTDRM'>DGBTDPV&(DGBTTC'<DGBTDRM) S DGBTDCV=DGBTDRM
S DGBTDCV=$S(DGBTMLT-DGBTDCV'>0:DGBTMLT,1:DGBTDCV)
I $G(DGBTDCV)>$G(DGBTDPV) S DGBTDCV=DGBTDPV
I $G(DGBTCC),'$G(DGBTCCREQ),$G(DGBTME) S DGBTMETC=(DGBTMETC+DGBTMAF)
DED1 ;
S DGBTDCV1=DGBTDCV ;save orig value for deductible
S DGBTDCVX="Computed"
S:DGBTDCV (DGBTWAIVER,DGBTDCV)=$$DWAIVER^DGBTUTL(DFN,DGBTDCV,DGBTDT),DGBTDCVX=$P(DGBTDCV,U,2),DGBTDCV=+DGBTDCV ;added by Pavel for patch 20
I '$G(DGBTREF),$G(DGBTDCV) S DGBTDCV=$S($P(MONTOT,"^",1)>6:0,1:$G(DGBTDCV)),DGBTDCVX="Computed"
I '$G(DGBTREF),$G(DGBTDCV),$G(DGBTCCREQ),$G(DGBTCC),$G(DGBTMLT),'$G(DGBTME) D S DGBTDCVX="Mode of transportation is Common Carrier/with Mileage" Q
.I '$G(DGBTREF),$G(DGBTWAIVER)'["Pension" S DGBTDCV=DGBTDCV1
.I '$G(DGBTREF),DGBTDCV>$G(DGBTMLT) S DGBTDCV=DGBTMLT-DGBTDCV S:DGBTDCV<0 DGBTDCV=0,DGBTTC=DGBTTC-DGBTMLT
I '$G(DGBTREF),$G(DGBTDCV),$G(DGBTCCREQ),$G(DGBTCC) S DGBTDCV=0,DGBTDCVX="Mode of transportation is Common Carrier" Q
I '$G(DGBTREF),'$G(DGBTDCV),$G(DGBTCCREQ),$G(DGBTCC),'$G(DGBTME),'$G(DGBTMLT) S DGBTDCV=0,DGBTDCVX="Mode of transportation is Common Carrier" Q
I '$G(DGBTREF),'$G(DGBTDCV),$G(DGBTCCREQ),$G(DGBTCC),$G(DGBTME),'$G(DGBTMLT) S DGBTDCV=0,DGBTDCVX="Mode of transportation is Common Carrier" Q
I $G(DGBTREF),$G(DGBTDCV) S DGBTDCV=$S($P(MONTOT,"^",1)>6:0,1:$G(DGBTDCV)),DGBTDCVX="Patient refuse to provide financial information"
Q
RATES ; checks parameter to ask meals & lodging, ferrys & bridges
S DGBTMLFB=$S($D(^DG(43,1,"BT")):$P(^DG(43,1,"BT"),"^",2),1:0)
; mileage rate
S DGBTMR=$S($D(^DG(43.1,$O(^DG(43.1,(9999999.99999-DGBTDT))),"BT")):$P(^("BT"),"^",3),1:0) ; ref file #43.1, MAS event rates file for BT rates
S DGBTMR1=$S($D(^DG(43.1,$O(^DG(43.1,(9999999.99999-DGBTDT))),"BT")):$P(^("BT"),"^",5),1:0) ; ref file #43.1, MAS event rates file for BT rates
ELIG ; lookup current eligibilities for patient and put into TMP list
S DGBTCT=1,^TMP("DGBT",$J,DGBTCT)=VAEL(1)
F I=0:0 S I=$O(VAEL(1,I)) Q:'I S DGBTCT=DGBTCT+1,^TMP("DGBT",$J,DGBTCT)=VAEL(1,I)
Q
ELIST ;
W !!?5,"Primary and other entitled eligibilities for patient:",!
I DGBTCT>1 F I=0:0 S I=$O(^TMP("DGBT",$J,I)) Q:'I W !?10,$P(^TMP("DGBT",$J,I),U,2)
Q
EXIT ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTEE2 4879 printed Dec 13, 2024@01:40:43 Page 2
DGBTEE2 ;ALB/SCK - BENEFICIARY TRAVEL ENTER/EDIT CONT ; 03/23/93
+1 ;;1.0;Beneficiary Travel;**17,20,39**;September 25, 2001;Build 6
START ;
+1 QUIT
STUFF ; stuff departure=home address, destination=division(ins) address, and attendant/payee=patient
+1 ;*39 - updated to use residential address
SET DGBTFR1=$SELECT($GET(CHZFLG):$PIECE(DGBTVAR("D"),"^",1),1:DGBTADDR(1))
SET DGBTFR2=$SELECT($GET(CHZFLG):$PIECE(DGBTVAR("D"),"^",2),1:DGBTADDR(2))
SET DGBTFR3=$SELECT($GET(CHZFLG):$PIECE(DGBTVAR("D"),"^",3),1:DGBTADDR(3))
SET DGBTAP=VADM(1)
+2 ;S DGBTFR1=$S('$G(CHZFLG):VAPA(1),1:$P(DGBTVAR("D"),"^",1)),DGBTFR2=$S('$G(CHZFLG):VAPA(2),1:$P(DGBTVAR("D"),"^",2)),DGBTFR3=$S('$G(CHZFLG):VAPA(3),1:$P(DGBTVAR("D"),"^",3)),DGBTAP=VADM(1)
+3 ; function call $$DEPCTY passes the zip code from the patient data, and returns with the departure city name or a null.
+4 ; if a null for the city is returned, the city name in the patient data is defaulted to.
+5 ;*39 - updated to use residential address
IF '$GET(CHZFLG)
SET XX=$$DEPCTY^DGBTUTL($PIECE(DGBTADDR(6),U))
SET X=$SELECT(+XX>0:$PIECE(XX,U,2),1:DGBTADDR(4))
+6 IF $GET(CHZFLG)
SET XX=$$DEPCTY^DGBTUTL($PIECE(DGBTVAR("D"),"^",6))
SET X=$SELECT(+XX>0:$PIECE(XX,U,2),1:$PIECE(DGBTVAR("D"),"^",4))
+7 DO UP^DGBTHELP
SET DGBTFR4=X
+8 KILL DGBTVAR(0)
SET DGBTVAR(0)=$SELECT($DATA(^DGBT(392,DGBTDT,0)):^(0),1:"")
+9 SET (DGBTDIV,DGBTDV1)=$PIECE(DGBTVAR(0),"^",11)
SET DGBTTO1=$PIECE(^DG(40.8,DGBTDIV,0),"^")
SET DGBTDIV=$PIECE(^DG(40.8,DGBTDIV,0),"^",7)
+10 SET (DGBTTO2,DGBTTO3,DGBTTO4,X)=""
+11 ; ref file #4, institution file by selected div
IF ('$GET(CHZFLG)&($DATA(^DIC(4,DGBTDIV,1))#10=1))
SET DGBTTO2=$PIECE(^DIC(4,DGBTDIV,1),"^")
SET DGBTTO3=$PIECE(^(1),"^",2)
SET X=$PIECE(^(1),"^",3)
DO UP^DGBTHELP
SET DGBTTO4=X
QUIT
+12 ;RFE DGBT*1.0*20
SET DGBTTO1=$PIECE(DGBTVAR("T"),U)
SET DGBTTO2=$PIECE(DGBTVAR("T"),U,2)
SET DGBTTO3=$PIECE(DGBTVAR("T"),U,3)
+13 ;RFE DGBT*1.0*20
SET XX=$$DEPCTY^DGBTUTL($PIECE(DGBTVAR("T"),"^",6))
SET X=$SELECT(+XX>0:$PIECE(XX,U,2),1:$PIECE(DGBTVAR("T"),"^",4))
+14 ;RFE DGBT*1.0*20
DO UP^DGBTHELP
SET DGBTTO4=X
+15 QUIT
DED ;
+1 IF $DATA(^DG(43.1,$ORDER(^DG(43.1,(9999999.99999-DGBTDT))),"BT"))
Begin DoDot:1
+2 ; ref file #43, MAS parameters file for BT settings
SET DGBTRATE=^("BT")
SET DGBTDPV=$PIECE(DGBTRATE,"^")
SET DGBTDPM=$PIECE(DGBTRATE,"^",2)
SET DGBTMR=$PIECE(DGBTRATE,"^",3)
+3 ; DGBTDPV = DEDUCTIBLE/VISIT DGBTDPM = DEDUCTIBLE/MONTH DGBTMR = MILEAGE RATE DGBTDCM = Deductible paid for this month
End DoDot:1
+4 ; ref file #392, claims file.
IF $DATA(^DGBT(392,DGBTDT,"M"))
IF $PIECE(^("M"),"^")=1
SET DGBTDPV=DGBTDPV/2
+5 ; Deductible to be paid
SET DGBTDRM=DGBTDPM-DGBTDCM
+6 IF DGBTDRM<0
SET DGBTDRM=0
+7 SET DGBTDCV=0
+8 IF DGBTDCM'<DGBTDPM
SET DGBTDCV=0
+9 IF DGBTDRM'<DGBTDPV&(DGBTTC'<DGBTDPV)
SET DGBTDCV=DGBTDPV
+10 IF DGBTDRM'<DGBTDPV&(DGBTTC'>DGBTDPV)
SET DGBTDCV=DGBTTC
+11 IF DGBTDRM'>DGBTDPV&(DGBTTC'>DGBTDRM)
SET DGBTDCV=DGBTTC
+12 IF DGBTDRM'>DGBTDPV&(DGBTTC'<DGBTDRM)
SET DGBTDCV=DGBTDRM
+13 SET DGBTDCV=$SELECT(DGBTMLT-DGBTDCV'>0:DGBTMLT,1:DGBTDCV)
+14 IF $GET(DGBTDCV)>$GET(DGBTDPV)
SET DGBTDCV=DGBTDPV
+15 IF $GET(DGBTCC)
IF '$GET(DGBTCCREQ)
IF $GET(DGBTME)
SET DGBTMETC=(DGBTMETC+DGBTMAF)
DED1 ;
+1 ;save orig value for deductible
SET DGBTDCV1=DGBTDCV
+2 SET DGBTDCVX="Computed"
+3 ;added by Pavel for patch 20
if DGBTDCV
SET (DGBTWAIVER,DGBTDCV)=$$DWAIVER^DGBTUTL(DFN,DGBTDCV,DGBTDT)
SET DGBTDCVX=$PIECE(DGBTDCV,U,2)
SET DGBTDCV=+DGBTDCV
+4 IF '$GET(DGBTREF)
IF $GET(DGBTDCV)
SET DGBTDCV=$SELECT($PIECE(MONTOT,"^",1)>6:0,1:$GET(DGBTDCV))
SET DGBTDCVX="Computed"
+5 IF '$GET(DGBTREF)
IF $GET(DGBTDCV)
IF $GET(DGBTCCREQ)
IF $GET(DGBTCC)
IF $GET(DGBTMLT)
IF '$GET(DGBTME)
Begin DoDot:1
+6 IF '$GET(DGBTREF)
IF $GET(DGBTWAIVER)'["Pension"
SET DGBTDCV=DGBTDCV1
+7 IF '$GET(DGBTREF)
IF DGBTDCV>$GET(DGBTMLT)
SET DGBTDCV=DGBTMLT-DGBTDCV
if DGBTDCV<0
SET DGBTDCV=0
SET DGBTTC=DGBTTC-DGBTMLT
End DoDot:1
SET DGBTDCVX="Mode of transportation is Common Carrier/with Mileage"
QUIT
+8 IF '$GET(DGBTREF)
IF $GET(DGBTDCV)
IF $GET(DGBTCCREQ)
IF $GET(DGBTCC)
SET DGBTDCV=0
SET DGBTDCVX="Mode of transportation is Common Carrier"
QUIT
+9 IF '$GET(DGBTREF)
IF '$GET(DGBTDCV)
IF $GET(DGBTCCREQ)
IF $GET(DGBTCC)
IF '$GET(DGBTME)
IF '$GET(DGBTMLT)
SET DGBTDCV=0
SET DGBTDCVX="Mode of transportation is Common Carrier"
QUIT
+10 IF '$GET(DGBTREF)
IF '$GET(DGBTDCV)
IF $GET(DGBTCCREQ)
IF $GET(DGBTCC)
IF $GET(DGBTME)
IF '$GET(DGBTMLT)
SET DGBTDCV=0
SET DGBTDCVX="Mode of transportation is Common Carrier"
QUIT
+11 IF $GET(DGBTREF)
IF $GET(DGBTDCV)
SET DGBTDCV=$SELECT($PIECE(MONTOT,"^",1)>6:0,1:$GET(DGBTDCV))
SET DGBTDCVX="Patient refuse to provide financial information"
+12 QUIT
RATES ; checks parameter to ask meals & lodging, ferrys & bridges
+1 SET DGBTMLFB=$SELECT($DATA(^DG(43,1,"BT")):$PIECE(^DG(43,1,"BT"),"^",2),1:0)
+2 ; mileage rate
+3 ; ref file #43.1, MAS event rates file for BT rates
SET DGBTMR=$SELECT($DATA(^DG(43.1,$ORDER(^DG(43.1,(9999999.99999-DGBTDT))),"BT")):$PIECE(^("BT"),"^",3),1:0)
+4 ; ref file #43.1, MAS event rates file for BT rates
SET DGBTMR1=$SELECT($DATA(^DG(43.1,$ORDER(^DG(43.1,(9999999.99999-DGBTDT))),"BT")):$PIECE(^("BT"),"^",5),1:0)
ELIG ; lookup current eligibilities for patient and put into TMP list
+1 SET DGBTCT=1
SET ^TMP("DGBT",$JOB,DGBTCT)=VAEL(1)
+2 FOR I=0:0
SET I=$ORDER(VAEL(1,I))
if 'I
QUIT
SET DGBTCT=DGBTCT+1
SET ^TMP("DGBT",$JOB,DGBTCT)=VAEL(1,I)
+3 QUIT
ELIST ;
+1 WRITE !!?5,"Primary and other entitled eligibilities for patient:",!
+2 IF DGBTCT>1
FOR I=0:0
SET I=$ORDER(^TMP("DGBT",$JOB,I))
if 'I
QUIT
WRITE !?10,$PIECE(^TMP("DGBT",$JOB,I),U,2)
+3 QUIT
EXIT ;
+1 QUIT
