24 lines
1.8 KiB
Mathematica
24 lines
1.8 KiB
Mathematica
|
RMPRFSH ;PHX/HNB-FRESHEN UP 660 AND 664 ;8/29/1994
|
||
|
|
;;3.0;PROSTHETICS;;Feb 09, 1996
|
||
|
|
EN1 ;RESET 664 ITEMS AFTER CLOSE OUT
|
||
|
|
F RI=0:0 S RI=$O(^TMP($J,1,RI)) Q:RI'>0 I '$D(^RMPR(664,RMPRA,1,RI,0)) D LPC
|
||
|
|
K %X,%Y,RI Q
|
||
|
|
EN2 ;REST 664 ITEMS IF NOT CLOSED OUT
|
||
|
|
F RI=0:0 S RI=$O(^TMP($J,1,RI)) Q:RI'>0 I '$D(^RMPR(664,RMPRA,1,RI,0)) D LP
|
||
|
|
I '$D(RMX) F RI=0:0 S RI=$O(^TMP($J,1,RI)) Q:RI'>0 S %X="^TMP($J,1,RI,",%Y="^RMPR(664,RMPRA,1,RI," D %XY^%RCR S DA(1)=RMPRA,DA=RI,DIK="^RMPR(664,"_RMPRA_",1," D IX^DIK
|
||
|
|
K RMX,%Y,%X,RI S $P(^RMPR(664,RMPRA,2),U,6)="" Q
|
||
|
|
LP ;SET DATA
|
||
|
|
I $D(^TMP($J,1,RI,0)) S RA=$P(^(0),U,13),RT=^TMP($J,RA,0) S X=$P(RT,U,1) K DD,DO S DIC="^RMPR(660,",DIC(0)="MLZ",DLAYGO=660 D FILE^DICN K DLAYGO
|
||
|
|
S RDA=+Y,%X="^TMP($J,RA,",%Y="^RMPR(660,RDA," D %XY^%RCR S DA=RDA,DIK="^RMPR(660," D IX^DIK
|
||
|
|
I $D(^TMP($J,1,RI,0)) S $P(^(0),U,13)=+RDA,%X="^TMP($J,1,RI,",%Y="^RMPR(664,RMPRA,1,RI," D %XY^%RCR S DA(1)=RMPRA,DA=RI,DIK="^RMPR(664,"_RMPRA_",1," D IX^DIK S RMX=1
|
||
|
|
Q
|
||
|
|
LPC I $D(^TMP($J,1,RI,0)) S RT=$P(^TMP($J,1,RI,0),U,13) I $D(^TMP($J,+RT,0)) S RT=$P(^TMP($J,+RT,0),U,13),$P(^TMP($J,1,RI,0),U,2)="NOT DELIVERED/ACCEPTED",$P(^(0),U,13)=""
|
||
|
|
S %X="^TMP($J,1,RI,",%Y="^RMPR(664,RMPRA,1,RI," D %XY^%RCR S DA(1)=RMPRA,DA=RI,DIK="^RMPR(664,"_RMPRA_",1," D IX^DIK I $D(RMPRP) S $P(^RMPR(664,RMPRA,2),U,4)=RMPRP
|
||
|
|
Q
|
||
|
|
GET ;SET TMP GLOBAL WITH PURCHASING TRANSACTION BEFORE CHANGES
|
||
|
|
S %X="^RMPR(664,RMPRA,1,",%Y="^TMP($J,1," D %XY^%RCR F RI=0:0 S RI=$O(^TMP($J,1,RI)) Q:RI'>0 I $D(^(RI,0)) S RA=$P(^(0),U,13) I $D(^RMPR(660,+RA,0)) S RMPRP=$P(^(0),U,13),%X="^RMPR(660,+RA,",%Y="^TMP($J,"_RA_"," D %XY^%RCR
|
||
|
|
I $D(^TMP($J)) S RA="1:PSC;2:2421;3:2237;4:2529-3;5:2529-7;6:2474;7:2431;8:2914;9:OTHER;10:2520;11:STOCK ISSUE;12:INVENTORY ISSUE;13:HISTORICAL DATA;"
|
||
|
|
;
|
||
|
|
I S RMPRP=$P($P(RA,";",RMPRP),":",2) I $D(^RMPR(664,RMPRA,2)),$P(^(2),U,5)'="" S RMPRPSC=$P(^(2),U,5) D PSCAMT^RMPRM
|
||
|
|
Q
|