source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPSSQA.m@ 1464

PRCPSSQA ;WISC/CC-Enter/edit privileged secondary IP users ;04/01

V ;;5.1;IFCAP;**24**;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

 ;

AC ;I 'application coordinator W "You do not have access to this option" Q

 I '$$KEY^PRCPUREP("PRCPAQOH",DUZ) D EN^DDIOL("You are not authorized to give staff access to replace quantities.") Q

 ;

 N D,D0,D1,DA,DIC,DIDEL,DIE,DIK,DLAYGO,DQ,DR,INVPT,PRCF,PRCPPRIV,USER,X,Y,%

 ; ask site

 S %=0 F I="FY","PARAM","PER","QTR","SITE" I '+$G(PRC(I)) S %=1 Q

 I % S PRCF("X")="S" D ^PRCFSITE I '+$G(PRC("SITE")) K PRC,PRCP Q

 ;

 ; ask inventory point

 I '$D(PRCP("DPTYPE")) S PRCP("DPTYPE")="S"

 S DIC="^PRCP(445,",DIC(0)="AEQMOZ"

 S DIC("S")="I +^(0)=PRC(""SITE"")"

 S DIC("S")=DIC("S")_",PRCP(""DPTYPE"")[$P(^PRCP(445,+Y,0),U,3)"

 S DIC("A")="Select Secondary Inventory Point: "

 S D="C",PRCPPRIV=1

 D IX^DIC K PRCPPRIV,DIC

 I Y<0 K PRC,PRCP Q

 S INVPT=Y Q:'$G(INVPT)

 I PRCP("DPTYPE")'="S" Q

 I '$D(^PRCP(445,+INVPT,0)) Q

 I $P($G(^PRCP(445,+INVPT,5)),"^",1)']"" D EN^DDIOL("This secondary is not linked to a supply station") Q

 ;

 L +^PRCP(445,+INVPT,8):3 I $T=0 D EN^DDIOL("The authorized user file is busy.  Please try again later.") Q

 ;

 ; purge inappropriate users

 S USER=0

 F  S USER=$O(^PRCP(445,+INVPT,8,USER)) Q:'+USER  D

 . S X=USER D CHK(+INVPT,.X) I X="" D

 . . D EN^DDIOL("Removing "_$P(^VA(200,USER,0),"^")_".....")

 . . S DIK="^PRCP(445,"_+INVPT_",8,",DA(1)=+INVPT,DA=+USER D ^DIK K DIK

 . . W "User DELETED !"

 ;

USERS ;  ask users

 I '$D(^PRCP(445,+INVPT,0)) D EN^DDIOL("This inventory point is not on file") Q

 I '$D(^PRCP(445,+INVPT,8,0)) S ^(0)="^445.026P^^"

 S DIC(0)="AEMQO"

 S DA=+INVPT,(DIC,DIE)="^PRCP(445,",DIDEL=445,DR=26,PRCPPRIV=1

 D ^DIE K PRCPPRIV,DIC,DIE

 Q

 ;

 ;

 ; invoked from this routine and input transform of .01 field in file 445.026

CHK(INVPT,USER) ; verify user has proper qualifications

 ;  INVPT   is the ien to file 445 (Inventory Point)

 ;  USER    is the ien to file 200

 ;

 I $P($G(^VA(200,USER,0)),"^",11),$P(^(0),"^",11)<DT D EN^DDIOL("You cannot ADD a terminated user.") S USER="" Q

 I '$D(^PRCP(445,INVPT,4,USER)) D EN^DDIOL("User has no access to this inventory point.  Contact the manager.") S USER="" Q

 I '$$KEY^PRCPUREP("PRCP2 MGRKEY",USER) S USER="" D EN^DDIOL("User needs the PRCP2 MGRKEY.") Q

 I '$$KEY^PRCPUREP("PRCPSSQOH",USER) S USER="" D EN^DDIOL("User needs the PRCPSSQOH key.") Q

 ;

EXIT L -^PRCP(445,+INVPT,8)

 Q