DGBTCD ;ALB/SCK/BLD - BENEFICIARY TRAVEL CLAIM DISPLAY; 12/15/92 4/14/93
;;1.0;Beneficiary Travel;**2,7,9,20,22,25,28**;September 25, 2001;Build 12
Q
SCREEN ;this will display the information screen at the end of a claim and
Q:'$D(^DGBT(392,DGBTDT,0)) S U="^" K DGBTVAR F I=0,"A","C","D","M","R","T" S DGBTVAR(I)=$S($D(^DGBT(392,DGBTDT,I)):^(I),1:"")
S DGBTACCT=$S($D(^DGBT(392.3,+$P(DGBTVAR(0),U,6),0)):$P($G(^(0)),U,5),1:0)
I 'DGBTACCT W !!,*7,">> WARNING! No ACCOUNT TYPE for this claim, Please correct through Claim Enter/Edit!" G QUIT
I '$P(DGBTVAR(0),U,11) W !!,*7,">> WARNING! No DIVISION specified for this claim, please correct through Claim Enter/Edit." G QUIT ;dbe patch DGBT*1*22
W @IOF
W !?18,"Beneficiary Travel Claim Information <Display>"
W !!,?2,"Claim Date: ",DGBTDTE W:$P(DGBTVAR(0),U,11)'=""&($D(^DG(40.8,$P(DGBTVAR(0),U,11),0))) ?40,"Division: ",$P(^DG(40.8,$P(DGBTVAR(0),U,11),0),U)
D PID^VADPT6 W !!?8,"Name: ",VADM(1),?40,"PT ID: ",VA("PID"),?64,"DOB: ",$P(VADM(3),U,2)
S (DGBTFCTY,DGBTTCTY)=""
I $P(DGBTVAR("D"),U,4)]"" S DGBTCNA=$P(DGBTVAR("D"),U,4) D CITY^DGBTCR I DGBTCSZ[DGBTCNA D
. S DGBTCSZ=DGBTCNA_", "_$S(+$P(DGBTVAR("D"),U,5)>0:$P(^DIC(5,$P(DGBTVAR("D"),U,5),0),U,2),1:"")_" "
. S Y=$P(DGBTVAR("D"),U,6),Y=$E(Y,1,5)_$S($E(Y,6,9)]"":"-"_$E(Y,6,9),1:"") S DGBTCSZ=DGBTCSZ_Y,DGBTFCTY=DGBTCSZ
S $P(DGBTVAR("T"),U,6)=$$GET1^DIQ(392,DGBTDT,28.2) ;dgbt*1.0*28 - use fileman to set external zip code value
I $P(DGBTVAR("T"),U,4)]"" S DGBTCNA=$P(DGBTVAR("T"),U,4) D CITY^DGBTCR S:DGBTCSZ[DGBTCNA DGBTCSZ=DGBTCNA_", "_$S(+$P(DGBTVAR("T"),U,5)>0:$P(^DIC(5,$P(DGBTVAR("T"),U,5),0),U,2),1:"")_" "_$P(DGBTVAR("T"),U,6) S DGBTTCTY=DGBTCSZ
FROM W !!," Depart From: ",$E($P(DGBTVAR("D"),U),1,30)
W ?46,"To: ",$E($P(DGBTVAR("T"),U),1,30)
W !?14 W:$P(DGBTVAR("D"),U,2)]"" $P(DGBTVAR("D"),U,2) W:$P(DGBTVAR("D"),U,2)="" $P(DGBTVAR("D"),U,3) W:$P($G(DGBTVAR("D")),U,2)=""&($P($G(DGBTVAR("D")),U,3)="") DGBTFCTY
W ?50 W:$P(DGBTVAR("T"),U,2)]"" $P(DGBTVAR("T"),U,2) W:$P(DGBTVAR("T"),U,2)="" $P(DGBTVAR("T"),U,3) W:$P(DGBTVAR("T"),U,2)=""&($P(DGBTVAR("T"),U,3)="") DGBTTCTY
W !?14 W:$P(DGBTVAR("D"),U,3)]"" $P(DGBTVAR("D"),U,3) W:$P(DGBTVAR("D"),U,2)]""&($P(DGBTVAR("D"),U,3)="") DGBTFCTY
W ?50 W:$P(DGBTVAR("T"),U,3)]"" $P(DGBTVAR("T"),U,3) W:$P(DGBTVAR("T"),U,2)]""&($P(DGBTVAR("T"),U,3)="") DGBTTCTY
W !?14 W:$P(DGBTVAR("D"),U,2)]""&($P(DGBTVAR("D"),U,3)]"") DGBTFCTY
W ?50 W:$P(DGBTVAR("T"),U,2)]""&($P(DGBTVAR("T"),U,3)]"") DGBTTCTY
ELIG W !!," Eligibility: " W:$P(DGBTVAR(0),U,3) $P(^DIC(8,$P(DGBTVAR(0),U,3),0),U) W:$P(DGBTVAR(0),U,4)]"" ?45,"SC%: ",$P(DGBTVAR(0),U,4)
I $P(DGBTVAR(0),U,5) W ?57,"Cert. Date: " S VADAT("W")=9999999-$P($P(DGBTVAR(0),U,5),".") D ^VADATE W $P(VADATE("E"),"@") K VADAT,VADATE
ACCT W !!?5,"Account: ",$S($P(DGBTVAR(0),U,6):$E($P(^DGBT(392.3,$P(DGBTVAR(0),U,6),0),U),1,15),1:"") W:$P(DGBTVAR("A"),U,3) ?31,"REVIEW VISIT"
;question added for DG*1.0*20 E18
W !!,"Common Carrier Req: ",$S($$GET1^DIQ(392,DGBTDT,55.1)="YES":"YES",1:"NO") W ?48,"COMMON CARRIER FEE: " S X=$P(DGBTVAR("C"),U,2),X2="2$" N X3 D COMMA^%DTC W X ;
W !,?51,"Most Econ. Cost: " S X=$P(DGBTVAR(0),U,8),X2="2$" N X3 D COMMA^%DTC W X
ATT I DGBTACCT=4!(DGBTACCT=5) W !,"Attend/Payee: ",$S($D(DGBTVAR("A")):$P(DGBTVAR("A"),U,2),1:"")
I $G(PATCHDT)'<$G(DGBTDT) I $G(DGBTACCT)'=4&($G(DGBTACCT)'=5) W !," Mode/Trans.: ",$S($P($G(DGBTVAR("A")),U,4):$P(^DGBT(392.43,$P($G(DGBTVAR("A")),U,4),0),U),1:"") ;changed file from 392.4 to 392.43
I $G(PATCHDT)<$G(DGBTDT) I $G(DGBTACCT)'=4&($G(DGBTACCT)'=5) W !," Mode/Trans.: ",$S($P($G(DGBTVAR("A")),U,4):$P(^DGBT(392.4,$P($G(DGBTVAR("A")),U,4),0),U),1:"") ;use file 392.4 if claim date is before install date
I $D(^DG(43,1,"BT")) I $P(^DG(43,1,"BT"),U,2)=1 W ?51,"Meals & Lodging: " S X=$P($G(DGBTVAR("M")),U,4) N X3 D COMMA^%DTC W X
I $G(DGBTACCT)=4!($G(DGBTACCT)=5) W !,"One Way/"
I $G(DGBTACCT)'=4&($G(DGBTACCT)'=5) D
. S DGX=$S($P($G(DGBTVAR(0)),U,7):"Carrier",$P($G(DGBTVAR(0)),U,14):"CoreFLS",1:"Carrier") W:DGX["FLS" !,"CoreFLS Carrier: " W:DGX["Carrier" !?5,"Carrier: "
. W $E($S((DGX["FLS"&$P($G(DGBTVAR(0)),U,14)):$P(^DGBT(392.31,$P($G(DGBTVAR(0)),U,14),0),U),(DGX["Carrier"&$P(DGBTVAR(0),U,7)):$$GET1^DIQ(392,DGBTDT_",",7)),1,27) K DGX
I $D(^DG(43,1,"BT")) I $P(^DG(43,1,"BT"),U,2)=1 W ?46,"Ferry, Bridges, Etc.: " S X=$P(DGBTVAR("M"),U,5) N X3 D COMMA^%DTC W X
I $G(DGBTACCT)=4!($G(DGBTACCT)=5) W !?2,"Round Trip: ",$S($P(DGBTVAR("M"),U)=1:"ONE WAY",$P(DGBTVAR("M"),U)=2:"ROUND TRIP",1:"")
I $G(DGBTACCT)'=4&($G(DGBTACCT)'=5) W !,"Auth. Person: " I $P(DGBTVAR("A"),U) W $S($D(DGBTVAR("A"))&($D(^VA(200,$P(DGBTVAR("A"),U),0))):$P(^VA(200,$P(DGBTVAR("A"),U),0),U),1:"")
I $G(DGBTACCT)=4!($G(DGBTACCT)=5) W ?46,"Total Mileage Amount: " D N X3 D COMMA^%DTC W X
.S X=$P(DGBTVAR("M"),U,3)
I $G(DGBTACCT)=4!($G(DGBTACCT)=5) W !,"Mileage/"
DED W ?48,"Applied Deductible: " D N X3 D COMMA^%DTC W X
.S X=$P($G(DGBTVAR(0)),"^",9) ;$G(DGBTDCV1) ;$P(DGBTVAR(0),"^",9)
W ! W:$G(DGBTACCT)=4!($G(DGBTACCT)=5) ?5,"One Way: ",$P($G(DGBTVAR("M")),U,2)_" MILES"
W ?53,"Amount Payable " S X=$$GET1^DIQ(392,DGBTDT,10) N X3 D COMMA^%DTC W X
QUIT K DGBTCNA,DGBTCSZ,DGBTFCTY,DGBTTCTY,DGBTCNA,VADAM,X,X2,I ;DGBTDIV - dbe patch DGBT*1*25 - removed to preserve division for subsequent claims
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTCD 5425 printed Dec 13, 2024@01:40:25 Page 2
DGBTCD ;ALB/SCK/BLD - BENEFICIARY TRAVEL CLAIM DISPLAY; 12/15/92 4/14/93
+1 ;;1.0;Beneficiary Travel;**2,7,9,20,22,25,28**;September 25, 2001;Build 12
+2 QUIT
SCREEN ;this will display the information screen at the end of a claim and
+1 if '$DATA(^DGBT(392,DGBTDT,0))
QUIT
SET U="^"
KILL DGBTVAR
FOR I=0,"A","C","D","M","R","T"
SET DGBTVAR(I)=$SELECT($DATA(^DGBT(392,DGBTDT,I)):^(I),1:"")
+2 SET DGBTACCT=$SELECT($DATA(^DGBT(392.3,+$PIECE(DGBTVAR(0),U,6),0)):$PIECE($GET(^(0)),U,5),1:0)
+3 IF 'DGBTACCT
WRITE !!,*7,">> WARNING! No ACCOUNT TYPE for this claim, Please correct through Claim Enter/Edit!"
GOTO QUIT
+4 ;dbe patch DGBT*1*22
IF '$PIECE(DGBTVAR(0),U,11)
WRITE !!,*7,">> WARNING! No DIVISION specified for this claim, please correct through Claim Enter/Edit."
GOTO QUIT
+5 WRITE @IOF
+6 WRITE !?18,"Beneficiary Travel Claim Information <Display>"
+7 WRITE !!,?2,"Claim Date: ",DGBTDTE
if $PIECE(DGBTVAR(0),U,11)'=""&($DATA(^DG(40.8,$PIECE(DGBTVAR(0),U,11),0)))
WRITE ?40,"Division: ",$PIECE(^DG(40.8,$PIECE(DGBTVAR(0),U,11),0),U)
+8 DO PID^VADPT6
WRITE !!?8,"Name: ",VADM(1),?40,"PT ID: ",VA("PID"),?64,"DOB: ",$PIECE(VADM(3),U,2)
+9 SET (DGBTFCTY,DGBTTCTY)=""
+10 IF $PIECE(DGBTVAR("D"),U,4)]""
SET DGBTCNA=$PIECE(DGBTVAR("D"),U,4)
DO CITY^DGBTCR
IF DGBTCSZ[DGBTCNA
Begin DoDot:1
+11 SET DGBTCSZ=DGBTCNA_", "_$SELECT(+$PIECE(DGBTVAR("D"),U,5)>0:$PIECE(^DIC(5,$PIECE(DGBTVAR("D"),U,5),0),U,2),1:"")_" "
+12 SET Y=$PIECE(DGBTVAR("D"),U,6)
SET Y=$EXTRACT(Y,1,5)_$SELECT($EXTRACT(Y,6,9)]"":"-"_$EXTRACT(Y,6,9),1:"")
SET DGBTCSZ=DGBTCSZ_Y
SET DGBTFCTY=DGBTCSZ
End DoDot:1
+13 ;dgbt*1.0*28 - use fileman to set external zip code value
SET $PIECE(DGBTVAR("T"),U,6)=$$GET1^DIQ(392,DGBTDT,28.2)
+14 IF $PIECE(DGBTVAR("T"),U,4)]""
SET DGBTCNA=$PIECE(DGBTVAR("T"),U,4)
DO CITY^DGBTCR
if DGBTCSZ[DGBTCNA
SET DGBTCSZ=DGBTCNA_", "_$SELECT(+$PIECE(DGBTVAR("T"),U,5)>0:$PIECE(^DIC(5,$PIECE(DGBTVAR("T"),U,5),0),U,2),1:"")_" "_$PIECE(DGBTVAR("T"),U,6)
SET DGBTTCTY=DGBTCSZ
FROM WRITE !!," Depart From: ",$EXTRACT($PIECE(DGBTVAR("D"),U),1,30)
+1 WRITE ?46,"To: ",$EXTRACT($PIECE(DGBTVAR("T"),U),1,30)
+2 WRITE !?14
if $PIECE(DGBTVAR("D"),U,2)]""
WRITE $PIECE(DGBTVAR("D"),U,2)
if $PIECE(DGBTVAR("D"),U,2)=""
WRITE $PIECE(DGBTVAR("D"),U,3)
if $PIECE($GET(DGBTVAR("D")),U,2)=""&($PIECE($GET(DGBTVAR("D")),U,3)="")
WRITE DGBTFCTY
+3 WRITE ?50
if $PIECE(DGBTVAR("T"),U,2)]""
WRITE $PIECE(DGBTVAR("T"),U,2)
if $PIECE(DGBTVAR("T"),U,2)=""
WRITE $PIECE(DGBTVAR("T"),U,3)
if $PIECE(DGBTVAR("T"),U,2)=""&($PIECE(DGBTVAR("T"),U,3)="")
WRITE DGBTTCTY
+4 WRITE !?14
if $PIECE(DGBTVAR("D"),U,3)]""
WRITE $PIECE(DGBTVAR("D"),U,3)
if $PIECE(DGBTVAR("D"),U,2)]""&($PIECE(DGBTVAR("D"),U,3)="")
WRITE DGBTFCTY
+5 WRITE ?50
if $PIECE(DGBTVAR("T"),U,3)]""
WRITE $PIECE(DGBTVAR("T"),U,3)
if $PIECE(DGBTVAR("T"),U,2)]""&($PIECE(DGBTVAR("T"),U,3)="")
WRITE DGBTTCTY
+6 WRITE !?14
if $PIECE(DGBTVAR("D"),U,2)]""&($PIECE(DGBTVAR("D"),U,3)]"")
WRITE DGBTFCTY
+7 WRITE ?50
if $PIECE(DGBTVAR("T"),U,2)]""&($PIECE(DGBTVAR("T"),U,3)]"")
WRITE DGBTTCTY
ELIG WRITE !!," Eligibility: "
if $PIECE(DGBTVAR(0),U,3)
WRITE $PIECE(^DIC(8,$PIECE(DGBTVAR(0),U,3),0),U)
if $PIECE(DGBTVAR(0),U,4)]""
WRITE ?45,"SC%: ",$PIECE(DGBTVAR(0),U,4)
+1 IF $PIECE(DGBTVAR(0),U,5)
WRITE ?57,"Cert. Date: "
SET VADAT("W")=9999999-$PIECE($PIECE(DGBTVAR(0),U,5),".")
DO ^VADATE
WRITE $PIECE(VADATE("E"),"@")
KILL VADAT,VADATE
ACCT WRITE !!?5,"Account: ",$SELECT($PIECE(DGBTVAR(0),U,6):$EXTRACT($PIECE(^DGBT(392.3,$PIECE(DGBTVAR(0),U,6),0),U),1,15),1:"")
if $PIECE(DGBTVAR("A"),U,3)
WRITE ?31,"REVIEW VISIT"
+1 ;question added for DG*1.0*20 E18
+2 ;
WRITE !!,"Common Carrier Req: ",$SELECT($$GET1^DIQ(392,DGBTDT,55.1)="YES":"YES",1:"NO")
WRITE ?48,"COMMON CARRIER FEE: "
SET X=$PIECE(DGBTVAR("C"),U,2)
SET X2="2$"
NEW X3
DO COMMA^%DTC
WRITE X
+3 WRITE !,?51,"Most Econ. Cost: "
SET X=$PIECE(DGBTVAR(0),U,8)
SET X2="2$"
NEW X3
DO COMMA^%DTC
WRITE X
ATT IF DGBTACCT=4!(DGBTACCT=5)
WRITE !,"Attend/Payee: ",$SELECT($DATA(DGBTVAR("A")):$PIECE(DGBTVAR("A"),U,2),1:"")
+1 ;changed file from 392.4 to 392.43
IF $GET(PATCHDT)'<$GET(DGBTDT)
IF $GET(DGBTACCT)'=4&($GET(DGBTACCT)'=5)
WRITE !," Mode/Trans.: ",$SELECT($PIECE($GET(DGBTVAR("A")),U,4):$PIECE(^DGBT(392.43,$PIECE($GET(DGBTVAR("A")),U,4),0),U),1:"")
+2 ;use file 392.4 if claim date is before install date
IF $GET(PATCHDT)<$GET(DGBTDT)
IF $GET(DGBTACCT)'=4&($GET(DGBTACCT)'=5)
WRITE !," Mode/Trans.: ",$SELECT($PIECE($GET(DGBTVAR("A")),U,4):$PIECE(^DGBT(392.4,$PIECE($GET(DGBTVAR("A")),U,4),0),U),1:"")
+3 IF $DATA(^DG(43,1,"BT"))
IF $PIECE(^DG(43,1,"BT"),U,2)=1
WRITE ?51,"Meals & Lodging: "
SET X=$PIECE($GET(DGBTVAR("M")),U,4)
NEW X3
DO COMMA^%DTC
WRITE X
+4 IF $GET(DGBTACCT)=4!($GET(DGBTACCT)=5)
WRITE !,"One Way/"
+5 IF $GET(DGBTACCT)'=4&($GET(DGBTACCT)'=5)
Begin DoDot:1
+6 SET DGX=$SELECT($PIECE($GET(DGBTVAR(0)),U,7):"Carrier",$PIECE($GET(DGBTVAR(0)),U,14):"CoreFLS",1:"Carrier")
if DGX["FLS"
WRITE !,"CoreFLS Carrier: "
if DGX["Carrier"
WRITE !?5,"Carrier: "
+7 WRITE $EXTRACT($SELECT((DGX["FLS"&$PIECE($GET(DGBTVAR(0)),U,14)):$PIECE(^DGBT(392.31,$PIECE($GET(DGBTVAR(0)),U,14),0),U),(DGX["Carrier"&$PIECE(DGBTVAR(0),U,7)):$$GET1^DIQ(392,DGBTDT_",",7)),1,27)
KILL DGX
End DoDot:1
+8 IF $DATA(^DG(43,1,"BT"))
IF $PIECE(^DG(43,1,"BT"),U,2)=1
WRITE ?46,"Ferry, Bridges, Etc.: "
SET X=$PIECE(DGBTVAR("M"),U,5)
NEW X3
DO COMMA^%DTC
WRITE X
+9 IF $GET(DGBTACCT)=4!($GET(DGBTACCT)=5)
WRITE !?2,"Round Trip: ",$SELECT($PIECE(DGBTVAR("M"),U)=1:"ONE WAY",$PIECE(DGBTVAR("M"),U)=2:"ROUND TRIP",1:"")
+10 IF $GET(DGBTACCT)'=4&($GET(DGBTACCT)'=5)
WRITE !,"Auth. Person: "
IF $PIECE(DGBTVAR("A"),U)
WRITE $SELECT($DATA(DGBTVAR("A"))&($DATA(^VA(200,$PIECE(DGBTVAR("A"),U),0))):$PIECE(^VA(200,$PIECE(DGBTVAR("A"),U),0),U),1:"")
+11 IF $GET(DGBTACCT)=4!($GET(DGBTACCT)=5)
WRITE ?46,"Total Mileage Amount: "
Begin DoDot:1
+12 SET X=$PIECE(DGBTVAR("M"),U,3)
End DoDot:1
NEW X3
DO COMMA^%DTC
WRITE X
+13 IF $GET(DGBTACCT)=4!($GET(DGBTACCT)=5)
WRITE !,"Mileage/"
DED WRITE ?48,"Applied Deductible: "
Begin DoDot:1
+1 ;$G(DGBTDCV1) ;$P(DGBTVAR(0),"^",9)
SET X=$PIECE($GET(DGBTVAR(0)),"^",9)
End DoDot:1
NEW X3
DO COMMA^%DTC
WRITE X
+2 WRITE !
if $GET(DGBTACCT)=4!($GET(DGBTACCT)=5)
WRITE ?5,"One Way: ",$PIECE($GET(DGBTVAR("M")),U,2)_" MILES"
+3 WRITE ?53,"Amount Payable "
SET X=$$GET1^DIQ(392,DGBTDT,10)
NEW X3
DO COMMA^%DTC
WRITE X
QUIT ;DGBTDIV - dbe patch DGBT*1*25 - removed to preserve division for subsequent claims
KILL DGBTCNA,DGBTCSZ,DGBTFCTY,DGBTTCTY,DGBTCNA,VADAM,X,X2,I
+1 QUIT
