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