RMPRP2 ;PHX/JLT-APPROVE PURCHASE REQUESTS ;10/01/1994
 ;;3.0;PROSTHETICS;;Feb 09, 1996
ASK ;ASK FOR MUTLIPLE ASSGIN
 K RMPRSNG D DIV4^RMPRSIT G:$D(X) EXIT
 K RMPRSBP D AP^RMPRSEC G:$G(X1)="" EXIT S RMPRESIG=X1
 I $G(RMPRX)="^" K RMPRX G EXIT
 S DIR(0)="Y",DIR("A")="Would you like Approve Multiple Purchases",DIR("B")="YES" D ^DIR G:$D(DIRUT)!($D(DTOUT)) EXIT I +Y=1 D MUTL G EXIT
SIG ;SINGEL APPROVE
 S RMPRSNG=1,DIC(0)="AEQMZ",DIC("W")="D EN2^RMPRD1",DIC="^RMPR(664,",DIC("S")="I $P($G(^RMPR(664,+Y,4)),U,8)=1" D ^DIC G:+Y'>0 EXIT S RMPRDA=+Y
DSP ;DISPLAY PURCHASE INFO
 S IOP="HOME",(FR,TO)=RMPRDA,BY="@NUMBER",DIC="^RMPR(664,",L=0,FLDS="[RMPR APPROVE]" D EN1^DIP
APP ;APPROVE REQUEST
 I $Y<19 F  W ! Q:$Y>19
 K DIR,Y,DA S DIR(0)="Y",DIR("A")="Would you like to Approve this Request" D ^DIR I $D(DIRUT)!($D(DTOUT))!(+Y=0) W !!,?5,$C(7),"Request not Approved" H 2 G:$D(RMPRSNG) SIG
 I +Y=1 D SGN G:$D(RMPRSNG) SIG
 I +Y["^" K RMPRDA
 Q
SGN S $P(^RMPR(664,RMPRDA,4),U,3)=DUZ,$P(^(4),U,4)=RMPRSBT
 S $P(^RMPR(664,RMPRDA,4),U,7)=$$SUM^RMPRSEC(RMPRSBP),$P(^RMPR(664,RMPRDA,4),U,6)=$$ENCODE^RMPRSEC(RMPRSBP,DUZ,1),$P(^RMPR(664,RMPRDA,4),U,5)=DT
 K ^RMPR(664,"AP",RMPR("STA"),$P($G(^RMPR(664,RMPRDA,4)),U,9),RMPRDA)
 S $P(^RMPR(664,RMPRDA,4),U,8)=""
 Q
EXIT N RMPR,RMPRSITE D KILL^XUSCLEAN Q
MUTL ;APPROVE MULTIPLE REQUESTS
 F RMPRDT=0:0 S RMPRDT=$O(^RMPR(664,"AP",RMPR("STA"),RMPRDT)) Q:$G(RMPRDT)'>0  S RMPRDA=0 F  S RMPRDA=$O(^RMPR(664,"AP",RMPR("STA"),RMPRDT,RMPRDA)) Q:$G(RMPRDA)'>0  D DSP Q:$G(RMPRDA)'>0
 Q