source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPENEU.m@ 1638

Last change on this file since 1638 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1PRCPENEU ;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 ;
7USERS(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 ;
37ACTION(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 ;
51GETUSER() ; 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
Note: See TracBrowser for help on using the repository browser.