| 1 | XQSMDCPY ;ISC-SF/JLI - COPY ONE USER (PRIM & SEC MENUS, KEYS, FILES) TO ANOTHER USER ;01/23/96 11:18
|
|---|
| 2 | ;;8.0;KERNEL;**19**;Jul 10, 1995
|
|---|
| 3 | S XQBOSS=0 I $D(^XUSEC("XUMGR",DUZ)) S XQBOSS=1
|
|---|
| 4 | I 'XQBOSS W !!,?5,"Note: You must have been delegated these options and",!,?11,"keys to transfer them from user to user.",!
|
|---|
| 5 | ;I 'XQBOSS,$O(^VA(200,DUZ,19.5,0))'>0 W !!,$C(7),"No Menus have been delegated to you to use this option",!,"If there are questions see your site manager's staff." Q
|
|---|
| 6 | W !! S DIC("A")="Select the user to be COPIED FROM: ",DIC=200,DIC(0)="AQEM" D ^DIC Q:Y'>0 S XQUSR1=+Y
|
|---|
| 7 | S XQUSRPM=+$G(^VA(200,XQUSR1,201)) I XQUSRPM="" S XQUSRPM=0 W !,"The doner user has no primary meny."
|
|---|
| 8 | I 'XQBOSS,XQUSRPM>0,'$D(^VA(200,DUZ,19.5,"B",XQUSRPM)) W !,$C(7),"You are not able to give out this user's primary menu ",$P(^DIC(19,XQUSRPM,0),U) S XQUSRPM=0
|
|---|
| 9 | S XQUSEC(0)="" F I=0:0 S I=$O(^VA(200,XQUSR1,203,I)) Q:I'>0 S X=^(I,0),XQUSEC(+X)=$P(X,U,2) I 'XQBOSS,'$D(^VA(200,DUZ,19.5,"B",+X)) W !,$C(7),"Skipping secondary menu ",$P(^DIC(19,+X,0),U) K XQUSEC(+X)
|
|---|
| 10 | ;I XQUSRPM'>0,$O(XQUSEC(0))'>0 W !!,$C(7),"No Primary or Secondary Menus to copy -- quitting.",!! G EXIT
|
|---|
| 11 | S XQUSEK(0)="" F I=0:0 S I=$O(^VA(200,XQUSR1,51,I)) Q:I'>0 S X=+^(I,0) I $D(^DIC(19,+X,0)) S XQUSEK(X)=X I 'XQBOSS,'$D(^VA(200,DUZ,52,"B",X)) W !,$C(7),"Not authorized to give ",$P(^DIC(19.1,X,0),U)," key -- skipping" K XQUSEK(X)
|
|---|
| 12 | ;
|
|---|
| 13 | ;Get recipient user
|
|---|
| 14 | ;
|
|---|
| 15 | S DIC("A")="Select a USER to be COPIED TO: ",DIC="^VA(200,",DIC(0)="AEMQ"
|
|---|
| 16 | F XQI=0:0 D ^DIC Q:Y'>0 S XUSR(+Y)="",DIC("A")="Select ANOTHER USER: "
|
|---|
| 17 | K DIC
|
|---|
| 18 | ;
|
|---|
| 19 | G:$O(XUSR(0))'>0 EXIT
|
|---|
| 20 | R !!,"Do you want to QUEUE this job ? Y// ",X:DTIME Q:'$T!(X[U) S:X="" X="Y" I "Yy"[$E(X) D TSK G EXIT
|
|---|
| 21 | ;
|
|---|
| 22 | DQ ;
|
|---|
| 23 | F XQI=0:0 S XQI=$O(XUSR(XQI)) Q:XQI'>0 D COPY1
|
|---|
| 24 | EXIT ;
|
|---|
| 25 | K %,D,D0,DA,DI,DISYS,DIC,DIE,DR,X,XQBOSS,XQI,XQJ,XQUSEK,XQUSR1,XUSR,XQUSEC,XQUSRPM,Y
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | COPY1 I XQUSRPM>0 S DIE=200,DA=XQI,DR="201///"_$P(^DIC(19,XQUSRPM,0),U) D ^DIE
|
|---|
| 29 | S:'$D(^VA(200,XQI,203,0)) ^(0)="^200.03P" S DLAYGO=200
|
|---|
| 30 | F XQJ=0:0 S XQJ=$O(XQUSEC(XQJ)) Q:XQJ'>0 S DIC="^VA(200,"_XQI_",203,",DA(1)=XQI,DIC("P")=200.03,X=$P(^DIC(19,XQJ,0),U),DIC(0)="ML" D ^DIC I Y>0,'$P(Y,U,3),XQUSEC(XQJ)'="" S DIE=DIC,DIE("P")=200.03,DA=+Y,DR="2///"_XQUSEC(XQJ)_";" D ^DIE
|
|---|
| 31 | S:'$D(^VA(200,XQI,51,0)) ^(0)="^200.051P^"
|
|---|
| 32 | S (DA,DA(1))=XQI F XQJ=0:0 S XQJ=$O(XQUSEK(XQJ)) Q:XQJ'>0 S DIC="^VA(200,"_XQI_",51,",DIC("P")=200.051,DIC(0)="ML",X=$P(^DIC(19.1,XQUSEK(XQJ),0),U) D ^DIC
|
|---|
| 33 | K DLAYGO
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | TSK S ZTRTN="DQ^XQSMDCPY",ZTIO="",ZTSAVE("XUSR(")="",ZTDESC="XQSMD Copy User",ZTSAVE("XQUSRPM")="",ZTSAVE("XQUSEC(")="",ZTSAVE("XQUSEK(")="" D ^%ZTLOAD
|
|---|
| 37 | Q
|
|---|
