source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR121A.m@ 1765

Last change on this file since 1765 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 969 bytes
Line 
1RMPR121A ;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.
5DELIV 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
Note: See TracBrowser for help on using the repository browser.