source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR4E22.m@ 1005

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1RMPR4E22 ;PHX/HNB - PURCHASE CARD MODULE CLOSE-OUT ;3/1/1996
2 ;;3.0;PROSTHETICS;**3**;Feb 09, 1996
3 ;AMIS,660
4 S R2=^RMPR(664,RMPRA,1,R1,0),RMPRBD=$P(R2,U,2)
5 L +^RMPR(660,RMPRAR,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" Q
6 S R2=^RMPR(664,RMPRA,1,R1,0)
7 S RMPRTO=$P(R2,U,7) S:RMPRTO=""!(RMPRTO<0) RMPRTO=$P(R2,U,3)
8 S $P(^RMPR(660,RMPRAR,0),U,16)=RMPRTO*$P(R2,U,4)
9 S $P(^RMPR(660,RMPRAR,0),U,4)=$P(^RMPR(664,RMPRA,1,R1,0),U,9),$P(^RMPR(660,RMPRAR,"AM"),U,3)=$P(^RMPR(664,RMPRA,1,R1,0),U,10),$P(^RMPR(660,RMPRAR,"AM"),U,4)=$P(^RMPR(664,RMPRA,1,R1,0),U,11)
10 S $P(^RMPR(660,RMPRAR,0),U,7)=$P(^RMPR(664,RMPRA,1,R1,0),U,4)
11 S $P(^RMPR(660,RMPRAR,1),U,2)=RMPRBD K RMPRBD
12 S $P(^RMPR(660,RMPRAR,0),U,12)=RMPR("DDT"),$P(^(0),U,11)=RMPRSER
13 ;item remarks
14 S RMPRCC=$P(^RMPR(664,RMPRA,1,R1,0),U,8)
15 ;close remarks added to item remarks
16 S RMPRCC=$S(RMPRCC'="":RMPRCC_" "_$P($G(^RMPR(664,RMPRA,2)),U,3),1:$P($G(^RMPR(664,RMPRA,2)),U,3))
17 S $P(^RMPR(660,RMPRAR,0),U,18)=RMPRCC
18 ;bank authorization
19 I $D(^RMPR(664,RMPRA,4)) S $P(^RMPR(660,RMPRAR,4),U,2)=$P(^RMPR(664,RMPRA,4),U,2)
20 ;vendor tracking number
21 I $D(^RMPR(664,RMPRA,1,R1,4)) S $P(^RMPR(660,RMPRAR,4),U,1)=$P(^RMPR(664,RMPRA,1,R1,4),U,1)
22 S $P(^RMPR(660,RMPRAR,0),U,15)=$S($P(^RMPR(664,RMPRA,1,R1,0),U,6)="N":"*",1:"")
23 L -^RMPR(660,RMPRAR,0)
24 S DA=RMPRAR,DIK="^RMPR(660," D IX1^DIK W !,"Updated "_$P(R1,U,1)_" 10-2319 record for this Veteran"
25 I $D(RMPRWO),$D(^RMPR(664.2,+RMPRWO,0)) S DIC="^RMPR(664.2,"_RMPRWO_",1,",DA(1)=RMPRWO,DIC(0)="LZ",R660=^RMPR(660,RMPRAR,0),RMPRTRN=$P(^(1),U,1),X=$P(R660,U,6) D FILE^DICN I +Y>0 D
26 .S $P(^RMPR(664.2,RMPRWO,1,+Y,0),U,2)=$P(R660,U,7),$P(^(0),U,3)=$J($P(R660,U,16)/$P(R660,U,7),0,2),$P(^(0),U,6)=$P(R660,U,9),$P(^(0),U,7)=$P(R660,U,8),$P(^(0),U,8)=RMPRSER
27 .S $P(^RMPR(664.2,RMPRWO,1,+Y,0),U,10)=RMPRTRN,$P(^(0),U,4)=$P(R660,U,14),$P(^(0),U,11)=RMPRA,$P(^(0),U,12)=RMPRAR S DIK=DIC,DA(1)=RMPRWO,DA=+Y D IX1^DIK
28 .S ^RMPR(664.2,RMPRWO,1,"AC",RMPRA,DA)=""
29 Q
Note: See TracBrowser for help on using the repository browser.