- 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 Mar 13, 2025@21:40:20 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
