| 1 | PRCPSSQA ;WISC/CC-Enter/edit privileged secondary IP users ;04/01
|
|---|
| 2 | V ;;5.1;IFCAP;**24**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | AC ;I 'application coordinator W "You do not have access to this option" Q
|
|---|
| 7 | I '$$KEY^PRCPUREP("PRCPAQOH",DUZ) D EN^DDIOL("You are not authorized to give staff access to replace quantities.") Q
|
|---|
| 8 | ;
|
|---|
| 9 | N D,D0,D1,DA,DIC,DIDEL,DIE,DIK,DLAYGO,DQ,DR,INVPT,PRCF,PRCPPRIV,USER,X,Y,%
|
|---|
| 10 | ; ask site
|
|---|
| 11 | S %=0 F I="FY","PARAM","PER","QTR","SITE" I '+$G(PRC(I)) S %=1 Q
|
|---|
| 12 | I % S PRCF("X")="S" D ^PRCFSITE I '+$G(PRC("SITE")) K PRC,PRCP Q
|
|---|
| 13 | ;
|
|---|
| 14 | ; ask inventory point
|
|---|
| 15 | I '$D(PRCP("DPTYPE")) S PRCP("DPTYPE")="S"
|
|---|
| 16 | S DIC="^PRCP(445,",DIC(0)="AEQMOZ"
|
|---|
| 17 | S DIC("S")="I +^(0)=PRC(""SITE"")"
|
|---|
| 18 | S DIC("S")=DIC("S")_",PRCP(""DPTYPE"")[$P(^PRCP(445,+Y,0),U,3)"
|
|---|
| 19 | S DIC("A")="Select Secondary Inventory Point: "
|
|---|
| 20 | S D="C",PRCPPRIV=1
|
|---|
| 21 | D IX^DIC K PRCPPRIV,DIC
|
|---|
| 22 | I Y<0 K PRC,PRCP Q
|
|---|
| 23 | S INVPT=Y Q:'$G(INVPT)
|
|---|
| 24 | I PRCP("DPTYPE")'="S" Q
|
|---|
| 25 | I '$D(^PRCP(445,+INVPT,0)) Q
|
|---|
| 26 | I $P($G(^PRCP(445,+INVPT,5)),"^",1)']"" D EN^DDIOL("This secondary is not linked to a supply station") Q
|
|---|
| 27 | ;
|
|---|
| 28 | L +^PRCP(445,+INVPT,8):3 I $T=0 D EN^DDIOL("The authorized user file is busy. Please try again later.") Q
|
|---|
| 29 | ;
|
|---|
| 30 | ; purge inappropriate users
|
|---|
| 31 | S USER=0
|
|---|
| 32 | F S USER=$O(^PRCP(445,+INVPT,8,USER)) Q:'+USER D
|
|---|
| 33 | . S X=USER D CHK(+INVPT,.X) I X="" D
|
|---|
| 34 | . . D EN^DDIOL("Removing "_$P(^VA(200,USER,0),"^")_".....")
|
|---|
| 35 | . . S DIK="^PRCP(445,"_+INVPT_",8,",DA(1)=+INVPT,DA=+USER D ^DIK K DIK
|
|---|
| 36 | . . W "User DELETED !"
|
|---|
| 37 | ;
|
|---|
| 38 | USERS ; ask users
|
|---|
| 39 | I '$D(^PRCP(445,+INVPT,0)) D EN^DDIOL("This inventory point is not on file") Q
|
|---|
| 40 | I '$D(^PRCP(445,+INVPT,8,0)) S ^(0)="^445.026P^^"
|
|---|
| 41 | S DIC(0)="AEMQO"
|
|---|
| 42 | S DA=+INVPT,(DIC,DIE)="^PRCP(445,",DIDEL=445,DR=26,PRCPPRIV=1
|
|---|
| 43 | D ^DIE K PRCPPRIV,DIC,DIE
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | ;
|
|---|
| 47 | ; invoked from this routine and input transform of .01 field in file 445.026
|
|---|
| 48 | CHK(INVPT,USER) ; verify user has proper qualifications
|
|---|
| 49 | ; INVPT is the ien to file 445 (Inventory Point)
|
|---|
| 50 | ; USER is the ien to file 200
|
|---|
| 51 | ;
|
|---|
| 52 | I $P($G(^VA(200,USER,0)),"^",11),$P(^(0),"^",11)<DT D EN^DDIOL("You cannot ADD a terminated user.") S USER="" Q
|
|---|
| 53 | I '$D(^PRCP(445,INVPT,4,USER)) D EN^DDIOL("User has no access to this inventory point. Contact the manager.") S USER="" Q
|
|---|
| 54 | I '$$KEY^PRCPUREP("PRCP2 MGRKEY",USER) S USER="" D EN^DDIOL("User needs the PRCP2 MGRKEY.") Q
|
|---|
| 55 | I '$$KEY^PRCPUREP("PRCPSSQOH",USER) S USER="" D EN^DDIOL("User needs the PRCPSSQOH key.") Q
|
|---|
| 56 | ;
|
|---|
| 57 | EXIT L -^PRCP(445,+INVPT,8)
|
|---|
| 58 | Q
|
|---|
