DGBTCR1 ;ALB/SCK - BENEFICIARY TRAVEL FORM 70-3542d ; 2/7/88@08:00 6/11/93@09:30
;;1.0;Beneficiary Travel;**18,20,39**;September 25, 2001;Build 6
;This routine is a modification of AIVBTPRT / pmg / GRAND ISLAND ;07 Jul 88 12:02 PM
Q
;Called by DGBTCR
PRINT K I S $P(I,"=",65)="" W !?66,"|",I,"|",!?7,VADM(1),?50 I $D(^DIC(13,+VADM(9),0)) W $P(^(0),"^",4)
W ?66,"| VOUCHER FOR CASH REIMBURSEMENT OF BENEFICIARY TRAVEL EXPENSES |"
W !?7,VAPA(1),?50,$S($D(^DIC(5,+VAPA(5),1,+VAPA(7),0)):$P(^(0),"^",3),1:""),?66,"|" ;*39 - use vapa(7) mailing address county code
K I S $P(I,"=",65)="" W ?67,I,"|"
W !,?7,VAPA(2),?66,"| 2. Name and Address of Issuing Health Care Facility",?131,"|"
W !?7,VAPA(4),?40,$P(^DIC(5,+VAPA(5),0),"^",2),?50,$P(VAPA(11),U,2),?66,"|",?131,"|" ;*39 - use vapa(5) mailing address state
W !?66,"|",?131,"|"
W !?7,DGBTSSN,?21,$E($P(VADM(10),"^",2),1),?22,$P(VADM(5),"^"),?30,DGBTDOB,?50,DGBTDIV,?66,"|",?88,$P($G(DGBTINS),"^"),?131,"|"
W !?66,"|",?88 W:$P(DGBTINS1,"^")'="" $P(DGBTINS1,"^") W:$P(DGBTINS1,"^")="" $P(DGBTINS1,"^",2) W:$P(DGBTINS1,"^")=""&($P(DGBTINS1,"^",2)="") DGBTINS2 W ?131,"|"
W !?7,VAEL(7),?19 I $D(^DIC(8,+VAEL(1),0)) W $P(^(0),"^",4)
W ?21,DGBTSCP,?28 I $D(^DIC(21,+VAEL(2),0)) W $P(^(0),"^",3)
W ?66,"|",?88 W:$P(DGBTINS1,"^",2)'=""&($P(DGBTINS1,"^")'="") $P(DGBTINS1,"^",2) W:$P(DGBTINS1,"^")'=""&($P(DGBTINS1,"^",2)="") DGBTINS2 W:$P(DGBTINS1,"^")=""&($P(DGBTINS1,"^",2)'="") DGBTINS2 W ?131,"|"
W !?66,"|",?88 W:$P(DGBTINS1,"^")'=""&($P(DGBTINS1,"^",2)'="")&($P(DGBTINS,"^",2)'="") DGBTINS2 W ?131,"|"
W !," 1. Patient Data Card Information",?66,"|",?131,"|" D LINE
FISCAL W !,"| 3. Fiscal Symbols"
W ?30,$P(DGBTRATE,"^",4),?131,"|" D LINE
W !,"| 4. From (Place of Departure)",?66,"| 5. To (Destination)",?131,"|"
RMV ; W !,"|",?66,"|",?131,"|"
W !,"|",?12,$P(DGBTVAR("D"),"^"),?66,"|",?88,$P(DGBTVAR("T"),"^"),?131,"|"
W !,"|",?12 W:$P(DGBTVAR("D"),"^",2)'="" $P(DGBTVAR("D"),"^",2) W:$P(DGBTVAR("D"),"^",2)="" $P(DGBTVAR("D"),"^",3) W:$P(DGBTVAR("D"),"^",2)=""&($P(DGBTVAR("D"),"^",3)="") DGBTFCTY
W ?66,"|",?88 W:$P(DGBTVAR("T"),"^",2)'="" $P(DGBTVAR("T"),"^",2) W:$P(DGBTVAR("T"),"^",2)="" $P(DGBTVAR("T"),"^",3) W:$P(DGBTVAR("T"),"^",2)=""&($P(DGBTVAR("T"),"^",3)="") DGBTTCTY W ?131,"|"
W !,"|",?12 W:$P(DGBTVAR("D"),"^",3)'="" $P(DGBTVAR("D"),"^",3) W:$P(DGBTVAR("D"),"^",2)'=""&($P(DGBTVAR("D"),"^",3)="") DGBTFCTY
W ?66,"|",?88 W:$P(DGBTVAR("T"),"^",3)'="" $P(DGBTVAR("T"),"^",3) W:$P(DGBTVAR("T"),"^",2)'=""&($P(DGBTVAR("T"),"^",3)="") DGBTTCTY W ?131,"|"
W !,"|",?12 W:$P(DGBTVAR("D"),"^",2)'=""&($P(DGBTVAR("D"),"^",3)'="") DGBTFCTY
W ?66,"|",?88 W:$P(DGBTVAR("T"),"^",2)'=""&($P(DGBTVAR("T"),"^",3)'="") DGBTTCTY W ?131,"|" D LINE
Q
LINE K I S $P(I,"=",131)="" W !,"|",I,"|"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTCR1 2804 printed Dec 13, 2024@01:40:29 Page 2
DGBTCR1 ;ALB/SCK - BENEFICIARY TRAVEL FORM 70-3542d ; 2/7/88@08:00 6/11/93@09:30
+1 ;;1.0;Beneficiary Travel;**18,20,39**;September 25, 2001;Build 6
+2 ;This routine is a modification of AIVBTPRT / pmg / GRAND ISLAND ;07 Jul 88 12:02 PM
+3 QUIT
+4 ;Called by DGBTCR
PRINT KILL I
SET $PIECE(I,"=",65)=""
WRITE !?66,"|",I,"|",!?7,VADM(1),?50
IF $DATA(^DIC(13,+VADM(9),0))
WRITE $PIECE(^(0),"^",4)
+1 WRITE ?66,"| VOUCHER FOR CASH REIMBURSEMENT OF BENEFICIARY TRAVEL EXPENSES |"
+2 ;*39 - use vapa(7) mailing address county code
WRITE !?7,VAPA(1),?50,$SELECT($DATA(^DIC(5,+VAPA(5),1,+VAPA(7),0)):$PIECE(^(0),"^",3),1:""),?66,"|"
+3 KILL I
SET $PIECE(I,"=",65)=""
WRITE ?67,I,"|"
+4 WRITE !,?7,VAPA(2),?66,"| 2. Name and Address of Issuing Health Care Facility",?131,"|"
+5 ;*39 - use vapa(5) mailing address state
WRITE !?7,VAPA(4),?40,$PIECE(^DIC(5,+VAPA(5),0),"^",2),?50,$PIECE(VAPA(11),U,2),?66,"|",?131,"|"
+6 WRITE !?66,"|",?131,"|"
+7 WRITE !?7,DGBTSSN,?21,$EXTRACT($PIECE(VADM(10),"^",2),1),?22,$PIECE(VADM(5),"^"),?30,DGBTDOB,?50,DGBTDIV,?66,"|",?88,$PIECE($GET(DGBTINS),"^"),?131,"|"
+8 WRITE !?66,"|",?88
if $PIECE(DGBTINS1,"^")'=""
WRITE $PIECE(DGBTINS1,"^")
if $PIECE(DGBTINS1,"^")=""
WRITE $PIECE(DGBTINS1,"^",2)
if $PIECE(DGBTINS1,"^")=""&($PIECE(DGBTINS1,"^",2)="")
WRITE DGBTINS2
WRITE ?131,"|"
+9 WRITE !?7,VAEL(7),?19
IF $DATA(^DIC(8,+VAEL(1),0))
WRITE $PIECE(^(0),"^",4)
+10 WRITE ?21,DGBTSCP,?28
IF $DATA(^DIC(21,+VAEL(2),0))
WRITE $PIECE(^(0),"^",3)
+11 WRITE ?66,"|",?88
if $PIECE(DGBTINS1,"^",2)'=""&($PIECE(DGBTINS1,"^")'="")
WRITE $PIECE(DGBTINS1,"^",2)
if $PIECE(DGBTINS1,"^")'=""&($PIECE(DGBTINS1,"^",2)="")
WRITE DGBTINS2
if $PIECE(DGBTINS1,"^")=""&($PIECE(DGBTINS1,"^",2)'="")
WRITE DGBTINS2
WRITE ?131,"|"
+12 WRITE !?66,"|",?88
if $PIECE(DGBTINS1,"^")'=""&($PIECE(DGBTINS1,"^",2)'="")&($PIECE(DGBTINS,"^",2)'="")
WRITE DGBTINS2
WRITE ?131,"|"
+13 WRITE !," 1. Patient Data Card Information",?66,"|",?131,"|"
DO LINE
FISCAL WRITE !,"| 3. Fiscal Symbols"
+1 WRITE ?30,$PIECE(DGBTRATE,"^",4),?131,"|"
DO LINE
+2 WRITE !,"| 4. From (Place of Departure)",?66,"| 5. To (Destination)",?131,"|"
RMV ; W !,"|",?66,"|",?131,"|"
+1 WRITE !,"|",?12,$PIECE(DGBTVAR("D"),"^"),?66,"|",?88,$PIECE(DGBTVAR("T"),"^"),?131,"|"
+2 WRITE !,"|",?12
if $PIECE(DGBTVAR("D"),"^",2)'=""
WRITE $PIECE(DGBTVAR("D"),"^",2)
if $PIECE(DGBTVAR("D"),"^",2)=""
WRITE $PIECE(DGBTVAR("D"),"^",3)
if $PIECE(DGBTVAR("D"),"^",2)=""&($PIECE(DGBTVAR("D"),"^",3)="")
WRITE DGBTFCTY
+3 WRITE ?66,"|",?88
if $PIECE(DGBTVAR("T"),"^",2)'=""
WRITE $PIECE(DGBTVAR("T"),"^",2)
if $PIECE(DGBTVAR("T"),"^",2)=""
WRITE $PIECE(DGBTVAR("T"),"^",3)
if $PIECE(DGBTVAR("T"),"^",2)=""&($PIECE(DGBTVAR("T"),"^",3)="")
WRITE DGBTTCTY
WRITE ?131,"|"
+4 WRITE !,"|",?12
if $PIECE(DGBTVAR("D"),"^",3)'=""
WRITE $PIECE(DGBTVAR("D"),"^",3)
if $PIECE(DGBTVAR("D"),"^",2)'=""&($PIECE(DGBTVAR("D"),"^",3)="")
WRITE DGBTFCTY
+5 WRITE ?66,"|",?88
if $PIECE(DGBTVAR("T"),"^",3)'=""
WRITE $PIECE(DGBTVAR("T"),"^",3)
if $PIECE(DGBTVAR("T"),"^",2)'=""&($PIECE(DGBTVAR("T"),"^",3)="")
WRITE DGBTTCTY
WRITE ?131,"|"
+6 WRITE !,"|",?12
if $PIECE(DGBTVAR("D"),"^",2)'=""&($PIECE(DGBTVAR("D"),"^",3)'="")
WRITE DGBTFCTY
+7 WRITE ?66,"|",?88
if $PIECE(DGBTVAR("T"),"^",2)'=""&($PIECE(DGBTVAR("T"),"^",3)'="")
WRITE DGBTTCTY
WRITE ?131,"|"
DO LINE
+8 QUIT
LINE KILL I
SET $PIECE(I,"=",131)=""
WRITE !,"|",I,"|"
+1 QUIT
