source: cprs/branches/tmg-cprs/m_files/TMGMDCPY.m@ 1117

Last change on this file since 1117 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 4.1 KB
RevLine 
[796]1TMGMDCPY ;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
4 ;"Copied from XWSMDCPY for decompilation and modification
5
6 S XQBOSS=0
7 I $D(^XUSEC("XUMGR",DUZ)) S XQBOSS=1
8 I 'XQBOSS do
9 . W !!,?5,"Note: You must have been delegated these options and",!
10 . W ?11,"keys to transfer them from user to user.",!
11 ;"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
12 W !!
13
14 S DIC("A")="Select the user to be COPIED FROM: "
15 S DIC=200,DIC(0)="AQEM"
16 D ^DIC Q:Y'>0 S XQUSR1=+Y
17
18 S XQUSRPM=+$G(^VA(200,XQUSR1,201))
19 I XQUSRPM="" S XQUSRPM=0 W !,"The source user has no primary menu."
20
21 I 'XQBOSS,XQUSRPM>0,'$D(^VA(200,DUZ,19.5,"B",XQUSRPM)) do
22 . W !,$C(7),"You are not able to give out this user's primary menu ",$P(^DIC(19,XQUSRPM,0),U)
23 . S XQUSRPM=0
24
25 S XQUSEC(0)=""
26 F I=0:0 S I=$O(^VA(200,XQUSR1,203,I)) Q:I'>0 do ;"cycle through secondary menu options.
27 . S X=^(I,0)
28 . S XQUSEC(+X)=$P(X,U,2)
29 . I 'XQBOSS,'$D(^VA(200,DUZ,19.5,"B",+X)) do
30 . . W !,$C(7),"Skipping secondary menu ",$P(^DIC(19,+X,0),U)
31 . . K XQUSEC(+X)
32 ;"I XQUSRPM'>0,$O(XQUSEC(0))'>0 W !!,$C(7),"No Primary or Secondary Menus to copy -- quitting.",!! G EXIT
33
34 S XQUSEK(0)=""
35 F I=0:0 S I=$O(^VA(200,XQUSR1,51,I)) Q:I'>0 do ;"cycle through keys
36 . S X=+^(I,0)
37 . I $D(^DIC(19,+X,0)) do
38 . . S XQUSEK(X)=X
39 . . I 'XQBOSS,'$D(^VA(200,DUZ,52,"B",X)) do
40 . . . W !,$C(7),"Not authorized to give ",$P(^DIC(19.1,X,0),U)," key -- skipping"
41 . . . K XQUSEK(X)
42 ;
43 ;Get recipient user
44 ;
45 S DIC("A")="Select a USER to be COPIED TO: ",DIC="^VA(200,",DIC(0)="AEMQ"
46 F XQI=0:0 D ^DIC Q:Y'>0 S XUSR(+Y)="",DIC("A")="Select ANOTHER USER: "
47 K DIC
48 ;
49 goto:$O(XUSR(0))'>0 EXIT
50
51 R !!,"Do you want to QUEUE this job ? Y// ",X:DTIME
52 Q:'$T!(X[U)
53 S:X="" X="Y"
54 I "Yy"[$E(X) D TSK G EXIT
55 ;
56DQ ; ;"Optional entry point for tasked job
57 F XQI=0:0 S XQI=$O(XUSR(XQI)) Q:XQI'>0 D COPY1 ;"Cycle through Dest users.
58
59EXIT ;
60 K %,D,D0,DA,DI,DISYS,DIC,DIE,DR,X,XQBOSS,XQI,XQJ,XQUSEK,XQUSR1,XUSR,XQUSEC,XQUSRPM,Y
61 Q
62 ;" ---------- Actual work below ----------------
63COPY1 I XQUSRPM>0 do
64 . S DIE=200
65 . S DA=XQI
66 . S DR="201///"_$P(^DIC(19,XQUSRPM,0),U)
67 . D ^DIE
68 ;"XQI is dest user's IEN
69 S:'$D(^VA(200,XQI,203,0)) ^(0)="^200.03P"
70 S DLAYGO=200
71 F XQJ=0:0 S XQJ=$O(XQUSEC(XQJ)) Q:XQJ'>0 do
72 . S DIC="^VA(200,"_XQI_",203,"
73 . S DA(1)=XQI
74 . S DIC("P")=200.03
75 . S X=$P(^DIC(19,XQJ,0),U)
76 . S DIC(0)="ML"
77 . D ^DIC
78 . I Y>0,'$P(Y,U,3),XQUSEC(XQJ)'="" do
79 . . S DIE=DIC
80 . . S DIE("P")=200.03
81 . . S DA=+Y
82 . . S DR="2///"_XQUSEC(XQJ)_";"
83 . . D ^DIE
84 S:'$D(^VA(200,XQI,51,0)) ^(0)="^200.051P^"
85 S (DA,DA(1))=XQI F XQJ=0:0 S XQJ=$O(XQUSEK(XQJ)) Q:XQJ'>0 do
86 . S DIC="^VA(200,"_XQI_",51,"
87 . S DIC("P")=200.051
88 . S DIC(0)="ML"
89 . S X=$P(^DIC(19.1,XQUSEK(XQJ),0),U)
90 . D ^DIC
91 K DLAYGO
92 Q
93 ;
94TSK S ZTRTN="DQ^XQSMDCPY" ;"the entry point for the task.
95 S ZTIO=""
96
97 S ZTDESC="XQSMD Copy User"
98
99 ;"Save pointer to source's primary menu (e.g. '215')
100 S ZTSAVE("XQUSRPM")=""
101
102 ;"Save list of secondary menus. Format
103 ;" XQUSEC(MenuIEN)=Menu Synonym (piece 2) (or "")
104 ;" XQUSEC(MenuIEN)=Menu Synonym (piece 2) (or "")
105 S ZTSAVE("XQUSEC(")=""
106
107 ;"Save list of keys. Format
108 ;" XQUSEK(KeyIEN)=KeyIEN
109 S ZTSAVE("XQUSEK(")=""
110
111 ;"Save destination users. format:
112 ;" XUSR(+Y)=""
113 ;" XUSR(+Y)=""
114 S ZTSAVE("XUSR(")=""
115
116 D ^%ZTLOAD ;"launch task.
117 Q
Note: See TracBrowser for help on using the repository browser.