PRCPENEU ;WISC/RFJ-add and delete users from inventory points ;09 Jun 95
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
USERS(INVPT) ; add and delete users from inventory points
N %,DIR,DISTRALL,DISTRPT,PRCPFACT,PRCPFLAG,TYPE,USER,X,Y
K X S X(1)="You have the option to add or delete users from inventory points stocked by "_$$INVNAME^PRCPUX1(INVPT) W ! D DISPLAY^PRCPUX2(40,79,.X)
F D Q:$G(PRCPFACT)
. K X S X(1)="Do you want to ADD or DELETE users from inventory points ?" D DISPLAY^PRCPUX2(2,40,.X)
. S DIR(0)="SO^1:Add Users;2:Delete Users",DIR("A")="Select ACTION Type" D ^DIR I Y'=1,Y'=2 S PRCPFACT=1 Q
. S TYPE=+Y
. ;
. F D Q:$G(PRCPFLAG)
. . K DISTRALL,PRCPFLAG
. . K X S X(1)="Select ALL or SINGLE distribution points to "_$S(TYPE=1:"ADD users to.",1:"DELETE users from.")_" You can only "_$S(TYPE=1:"ADD USERS to",1:"DELETE users from")_" inventory points you have access to."
. . W ! D DISPLAY^PRCPUX2(2,40,.X)
. . S XP="Do you want to select ALL distribution points",XH="Enter 'YES' to select ALL distr. points, 'NO' to not select all distr. points."
. . S %=$$YN^PRCPUYN(2) I '% S PRCPFLAG=1 Q
. . I %=1 S DISTRALL=1
. . I %=2 D Q:$G(PRCPFLAG)
. . . S DISTRPT=$$TO^PRCPUDPT(INVPT) I DISTRPT<1 S PRCPFLAG=1 Q
. . . I '$D(^PRCP(445,DISTRPT,4,DUZ)) W !,"You cannot select this distribution point since you do not have access to it." Q
. . ;
. . F K X S X(1)="Select the users to "_$S(TYPE=1:"ADD TO",1:"DELETE FROM")_" the inventory points" W ! D DISPLAY^PRCPUX2(2,40,.X) S USER=$$GETUSER Q:USER<1 D
. . . I DUZ=USER W !,"You cannot select yourself ??" Q
. . . I TYPE=1,$P($G(^VA(200,USER,0)),"^",11),$P(^(0),"^",11)<DT W !,"You cannot ADD a terminated user ??" Q
. . . S XP="Ready to "_$S(TYPE=1:"ADD the user to ",1:"DELETE the user from ")_$S($G(DISTRALL):"ALL distribution points",1:" the distribution point")
. . . I $$YN^PRCPUYN(1)'=1 Q
. . . I '$G(DISTRALL) D ACTION(DISTRPT,USER,TYPE) Q
. . . ; all distribution points selected
. . . S DISTRPT=0 F S DISTRPT=$O(^PRCP(445,INVPT,2,DISTRPT)) Q:'DISTRPT D ACTION(DISTRPT,USER,TYPE)
Q
;
;
ACTION(INVPT,USER,TYPE) ; add/delete users from invpt
; type=1 for add, type=2 for delete
; duz=user processing add/delete
W !?5,"INVPT: ",$E($P($$INVNAME^PRCPUX1(INVPT),"-",2,99),1,20),?33
I '$D(^PRCP(445,INVPT,4,DUZ)) W "You do not have access to this inventory point" Q
I TYPE=1,$D(^PRCP(445,INVPT,4,USER)) W "User already has access to inventory point" Q
I TYPE=2,'$D(^PRCP(445,INVPT,4,USER)) W "User does not have access to inventory point" Q
; add
I TYPE=1 D ADDUSER^PRCPXTRM(INVPT,USER) W:$D(^PRCP(445,INVPT,4,USER)) "User ADDED !" Q
; delete
D KILLUSER^PRCPXTRM(INVPT,USER) I '$D(^PRCP(445,INVPT,4,USER)) W "User DELETED !"
Q
;
;
GETUSER() ; return selected user
N DIC,X,Y
S DIC="^VA(200,",DIC(0)="QEAM",DIC("A")="Select INVENTORY USER: " D ^DIC
Q +Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPENEU 3096 printed Sep 23, 2025@19:49:50 Page 2
PRCPENEU ;WISC/RFJ-add and delete users from inventory points ;09 Jun 95
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
USERS(INVPT) ; add and delete users from inventory points
+1 NEW %,DIR,DISTRALL,DISTRPT,PRCPFACT,PRCPFLAG,TYPE,USER,X,Y
+2 KILL X
SET X(1)="You have the option to add or delete users from inventory points stocked by "_$$INVNAME^PRCPUX1(INVPT)
WRITE !
DO DISPLAY^PRCPUX2(40,79,.X)
+3 FOR
Begin DoDot:1
+4 KILL X
SET X(1)="Do you want to ADD or DELETE users from inventory points ?"
DO DISPLAY^PRCPUX2(2,40,.X)
+5 SET DIR(0)="SO^1:Add Users;2:Delete Users"
SET DIR("A")="Select ACTION Type"
DO ^DIR
IF Y'=1
IF Y'=2
SET PRCPFACT=1
QUIT
+6 SET TYPE=+Y
+7 ;
+8 FOR
Begin DoDot:2
+9 KILL DISTRALL,PRCPFLAG
+10 KILL X
SET X(1)="Select ALL or SINGLE distribution points to "_$SELECT(TYPE=1:"ADD users to.",1:"DELETE users from.")_" You can only "_$SELECT(TYPE=1:"ADD USERS to",1:"DELETE users from")_" inventory points you have access to."
+11 WRITE !
DO DISPLAY^PRCPUX2(2,40,.X)
+12 SET XP="Do you want to select ALL distribution points"
SET XH="Enter 'YES' to select ALL distr. points, 'NO' to not select all distr. points."
+13 SET %=$$YN^PRCPUYN(2)
IF '%
SET PRCPFLAG=1
QUIT
+14 IF %=1
SET DISTRALL=1
+15 IF %=2
Begin DoDot:3
+16 SET DISTRPT=$$TO^PRCPUDPT(INVPT)
IF DISTRPT<1
SET PRCPFLAG=1
QUIT
+17 IF '$DATA(^PRCP(445,DISTRPT,4,DUZ))
WRITE !,"You cannot select this distribution point since you do not have access to it."
QUIT
End DoDot:3
if $GET(PRCPFLAG)
QUIT
+18 ;
+19 FOR
KILL X
SET X(1)="Select the users to "_$SELECT(TYPE=1:"ADD TO",1:"DELETE FROM")_" the inventory points"
WRITE !
DO DISPLAY^PRCPUX2(2,40,.X)
SET USER=$$GETUSER
if USER<1
QUIT
Begin DoDot:3
+20 IF DUZ=USER
WRITE !,"You cannot select yourself ??"
QUIT
+21 IF TYPE=1
IF $PIECE($GET(^VA(200,USER,0)),"^",11)
IF $PIECE(^(0),"^",11)<DT
WRITE !,"You cannot ADD a terminated user ??"
QUIT
+22 SET XP="Ready to "_$SELECT(TYPE=1:"ADD the user to ",1:"DELETE the user from ")_$SELECT($GET(DISTRALL):"ALL distribution points",1:" the distribution point")
+23 IF $$YN^PRCPUYN(1)'=1
QUIT
+24 IF '$GET(DISTRALL)
DO ACTION(DISTRPT,USER,TYPE)
QUIT
+25 ; all distribution points selected
+26 SET DISTRPT=0
FOR
SET DISTRPT=$ORDER(^PRCP(445,INVPT,2,DISTRPT))
if 'DISTRPT
QUIT
DO ACTION(DISTRPT,USER,TYPE)
End DoDot:3
End DoDot:2
if $GET(PRCPFLAG)
QUIT
End DoDot:1
if $GET(PRCPFACT)
QUIT
+27 QUIT
+28 ;
+29 ;
ACTION(INVPT,USER,TYPE) ; add/delete users from invpt
+1 ; type=1 for add, type=2 for delete
+2 ; duz=user processing add/delete
+3 WRITE !?5,"INVPT: ",$EXTRACT($PIECE($$INVNAME^PRCPUX1(INVPT),"-",2,99),1,20),?33
+4 IF '$DATA(^PRCP(445,INVPT,4,DUZ))
WRITE "You do not have access to this inventory point"
QUIT
+5 IF TYPE=1
IF $DATA(^PRCP(445,INVPT,4,USER))
WRITE "User already has access to inventory point"
QUIT
+6 IF TYPE=2
IF '$DATA(^PRCP(445,INVPT,4,USER))
WRITE "User does not have access to inventory point"
QUIT
+7 ; add
+8 IF TYPE=1
DO ADDUSER^PRCPXTRM(INVPT,USER)
if $DATA(^PRCP(445,INVPT,4,USER))
WRITE "User ADDED !"
QUIT
+9 ; delete
+10 DO KILLUSER^PRCPXTRM(INVPT,USER)
IF '$DATA(^PRCP(445,INVPT,4,USER))
WRITE "User DELETED !"
+11 QUIT
+12 ;
+13 ;
GETUSER() ; return selected user
+1 NEW DIC,X,Y
+2 SET DIC="^VA(200,"
SET DIC(0)="QEAM"
SET DIC("A")="Select INVENTORY USER: "
DO ^DIC
+3 QUIT +Y
