- 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 Mar 13, 2025@20:45:22 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
