| 1 | RMPR121A ;PHX/HNC -CREATE GUI PURCHASE CARD TRANSACTION CONT. ;3/1/2003
|
|---|
| 2 | ;;3.0;PROSTHETICS;**90**;Feb 09, 1996
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;04/01/05 Note some codeing for future use such as pt address.
|
|---|
| 5 | DELIV I RMPRY=1 D
|
|---|
| 6 | .S RMPRDDF="1^Y"
|
|---|
| 7 | .S DFN=$P(^RMPR(664,RMPRA,0),U,2)
|
|---|
| 8 | .D ALL^VADPT
|
|---|
| 9 | .S RMPRADD1=VADM(1)
|
|---|
| 10 | .S RMPRADD2=VAPA(1)
|
|---|
| 11 | .S RMPRCITY=VAPA(4)
|
|---|
| 12 | .S RMPRST=VAPA(5)
|
|---|
| 13 | .S RMPRZIP=VAPA(6)
|
|---|
| 14 | .I RMPRZIP="" S RMPRZIP="00000"
|
|---|
| 15 | I RMPRY=2 S RMPRDDF="2^N"
|
|---|
| 16 | I RMPRY=3 S RMPRDDF="3^N"
|
|---|
| 17 | I RMPRY=4 D
|
|---|
| 18 | .S RMPRDDF="4^Y"
|
|---|
| 19 | .S RMPRADD1=$P(^RMPR(664,RMPRA,3),U,5)
|
|---|
| 20 | .S RMPRADD2=$P(^RMPR(664,RMPRA,3),U,6)
|
|---|
| 21 | .S RMPRCITY=$P(^RMPR(664,RMPRA,3),U,7)
|
|---|
| 22 | .S RMPRST=$P(^RMPR(664,RMPRA,3),U,8)_"^"_$P(^DIC(5,$P(^RMPR(664,RMPRA,3),U,8),0),U,1)
|
|---|
| 23 | .S RMPRZIP=$P(^RMPR(664,RMPRA,3),U,9)
|
|---|
| 24 | ;deliver to other
|
|---|
| 25 | S RMPRDELN=RMPRY(0),$P(^RMPR(664,RMPRA,3),U)=RMPRDELN
|
|---|
| 26 | I RMPRY=3 S RMPRDELN=$P(^RMPR(664,RMPRA,3),U,4)
|
|---|
| 27 | I RMPRY=4 S RMPRDELN=$P(^RMPR(664,RMPRA,3),U,4)
|
|---|
| 28 | Q
|
|---|
