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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRP2 1536 printed Dec 13, 2024@02:35:27 Page 2
RMPRP2 ;PHX/JLT-APPROVE PURCHASE REQUESTS ;10/01/1994
+1 ;;3.0;PROSTHETICS;;Feb 09, 1996
ASK ;ASK FOR MUTLIPLE ASSGIN
+1 KILL RMPRSNG
DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
+2 KILL RMPRSBP
DO AP^RMPRSEC
if $GET(X1)=""
GOTO EXIT
SET RMPRESIG=X1
+3 IF $GET(RMPRX)="^"
KILL RMPRX
GOTO EXIT
+4 SET DIR(0)="Y"
SET DIR("A")="Would you like Approve Multiple Purchases"
SET DIR("B")="YES"
DO ^DIR
if $DATA(DIRUT)!($DATA(DTOUT))
GOTO EXIT
IF +Y=1
DO MUTL
GOTO EXIT
SIG ;SINGEL APPROVE
+1 SET RMPRSNG=1
SET DIC(0)="AEQMZ"
SET DIC("W")="D EN2^RMPRD1"
SET DIC="^RMPR(664,"
SET DIC("S")="I $P($G(^RMPR(664,+Y,4)),U,8)=1"
DO ^DIC
if +Y'>0
GOTO EXIT
SET RMPRDA=+Y
DSP ;DISPLAY PURCHASE INFO
+1 SET IOP="HOME"
SET (FR,TO)=RMPRDA
SET BY="@NUMBER"
SET DIC="^RMPR(664,"
SET L=0
SET FLDS="[RMPR APPROVE]"
DO EN1^DIP
APP ;APPROVE REQUEST
+1 IF $Y<19
FOR
WRITE !
if $Y>19
QUIT
+2 KILL DIR,Y,DA
SET DIR(0)="Y"
SET DIR("A")="Would you like to Approve this Request"
DO ^DIR
IF $DATA(DIRUT)!($DATA(DTOUT))!(+Y=0)
WRITE !!,?5,$CHAR(7),"Request not Approved"
HANG 2
if $DATA(RMPRSNG)
GOTO SIG
+3 IF +Y=1
DO SGN
if $DATA(RMPRSNG)
GOTO SIG
+4 IF +Y["^"
KILL RMPRDA
+5 QUIT
SGN SET $PIECE(^RMPR(664,RMPRDA,4),U,3)=DUZ
SET $PIECE(^(4),U,4)=RMPRSBT
+1 SET $PIECE(^RMPR(664,RMPRDA,4),U,7)=$$SUM^RMPRSEC(RMPRSBP)
SET $PIECE(^RMPR(664,RMPRDA,4),U,6)=$$ENCODE^RMPRSEC(RMPRSBP,DUZ,1)
SET $PIECE(^RMPR(664,RMPRDA,4),U,5)=DT
+2 KILL ^RMPR(664,"AP",RMPR("STA"),$PIECE($GET(^RMPR(664,RMPRDA,4)),U,9),RMPRDA)
+3 SET $PIECE(^RMPR(664,RMPRDA,4),U,8)=""
+4 QUIT
EXIT NEW RMPR,RMPRSITE
DO KILL^XUSCLEAN
QUIT
MUTL ;APPROVE MULTIPLE REQUESTS
+1 FOR RMPRDT=0:0
SET RMPRDT=$ORDER(^RMPR(664,"AP",RMPR("STA"),RMPRDT))
if $GET(RMPRDT)'>0
QUIT
SET RMPRDA=0
FOR
SET RMPRDA=$ORDER(^RMPR(664,"AP",RMPR("STA"),RMPRDT,RMPRDA))
if $GET(RMPRDA)'>0
QUIT
DO DSP
if $GET(RMPRDA)'>0
QUIT
+2 QUIT
