[613] | 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
|
---|