| 1 | PRCPENEU ;WISC/RFJ-add and delete users from inventory points       ;09 Jun 95 | 
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000 | 
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified. | 
|---|
| 4 | Q | 
|---|
| 5 | ; | 
|---|
| 6 | ; | 
|---|
| 7 | USERS(INVPT) ;  add and delete users from inventory points | 
|---|
| 8 | N %,DIR,DISTRALL,DISTRPT,PRCPFACT,PRCPFLAG,TYPE,USER,X,Y | 
|---|
| 9 | 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) | 
|---|
| 10 | F  D  Q:$G(PRCPFACT) | 
|---|
| 11 | .   K X S X(1)="Do you want to ADD or DELETE users from inventory points ?" D DISPLAY^PRCPUX2(2,40,.X) | 
|---|
| 12 | .   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 | 
|---|
| 13 | .   S TYPE=+Y | 
|---|
| 14 | .   ; | 
|---|
| 15 | .   F  D  Q:$G(PRCPFLAG) | 
|---|
| 16 | .   .   K DISTRALL,PRCPFLAG | 
|---|
| 17 | .   .   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." | 
|---|
| 18 | .   .   W ! D DISPLAY^PRCPUX2(2,40,.X) | 
|---|
| 19 | .   .   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." | 
|---|
| 20 | .   .   S %=$$YN^PRCPUYN(2) I '% S PRCPFLAG=1 Q | 
|---|
| 21 | .   .   I %=1 S DISTRALL=1 | 
|---|
| 22 | .   .   I %=2 D  Q:$G(PRCPFLAG) | 
|---|
| 23 | .   .   .   S DISTRPT=$$TO^PRCPUDPT(INVPT) I DISTRPT<1 S PRCPFLAG=1 Q | 
|---|
| 24 | .   .   .   I '$D(^PRCP(445,DISTRPT,4,DUZ)) W !,"You cannot select this distribution point since you do not have access to it." Q | 
|---|
| 25 | .   .   ; | 
|---|
| 26 | .   .   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 | 
|---|
| 27 | .   .   .   I DUZ=USER W !,"You cannot select yourself ??" Q | 
|---|
| 28 | .   .   .   I TYPE=1,$P($G(^VA(200,USER,0)),"^",11),$P(^(0),"^",11)<DT W !,"You cannot ADD a terminated user ??" Q | 
|---|
| 29 | .   .   .   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") | 
|---|
| 30 | .   .   .   I $$YN^PRCPUYN(1)'=1 Q | 
|---|
| 31 | .   .   .   I '$G(DISTRALL) D ACTION(DISTRPT,USER,TYPE) Q | 
|---|
| 32 | .   .   .   ;  all distribution points selected | 
|---|
| 33 | .   .   .   S DISTRPT=0 F  S DISTRPT=$O(^PRCP(445,INVPT,2,DISTRPT)) Q:'DISTRPT  D ACTION(DISTRPT,USER,TYPE) | 
|---|
| 34 | Q | 
|---|
| 35 | ; | 
|---|
| 36 | ; | 
|---|
| 37 | ACTION(INVPT,USER,TYPE)      ;  add/delete users from invpt | 
|---|
| 38 | ;  type=1 for add, type=2 for delete | 
|---|
| 39 | ;  duz=user processing add/delete | 
|---|
| 40 | W !?5,"INVPT: ",$E($P($$INVNAME^PRCPUX1(INVPT),"-",2,99),1,20),?33 | 
|---|
| 41 | I '$D(^PRCP(445,INVPT,4,DUZ)) W "You do not have access to this inventory point" Q | 
|---|
| 42 | I TYPE=1,$D(^PRCP(445,INVPT,4,USER)) W "User already has access to inventory point" Q | 
|---|
| 43 | I TYPE=2,'$D(^PRCP(445,INVPT,4,USER)) W "User does not have access to inventory point" Q | 
|---|
| 44 | ;  add | 
|---|
| 45 | I TYPE=1 D ADDUSER^PRCPXTRM(INVPT,USER) W:$D(^PRCP(445,INVPT,4,USER)) "User ADDED !" Q | 
|---|
| 46 | ;  delete | 
|---|
| 47 | D KILLUSER^PRCPXTRM(INVPT,USER) I '$D(^PRCP(445,INVPT,4,USER)) W "User DELETED !" | 
|---|
| 48 | Q | 
|---|
| 49 | ; | 
|---|
| 50 | ; | 
|---|
| 51 | GETUSER() ;  return selected user | 
|---|
| 52 | N DIC,X,Y | 
|---|
| 53 | S DIC="^VA(200,",DIC(0)="QEAM",DIC("A")="Select INVENTORY USER: " D ^DIC | 
|---|
| 54 | Q +Y | 
|---|