source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQ6A.m@ 1141

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1XQ6A ;SEA/AMF,SLC/CJS- BULK KEY DISTRIBUTION ;5:22 AM 19 Jun 2002
2 ;;8.0;KERNEL;**12,147**;Jul 10, 1995
3HOLDER ;
4 W !!,$S($O(XQHOLD(0))>0:"Another holder: ",1:"Holder of key: ") R X:DTIME S:'$T X=U G:X[U OUT
5 I '$L(X) G:($O(XQHOLD(0))>0) OK W " ??",$C(7),!,"You have not yet selected any holders." G HOLDER
6 I X["?" S XQH="XQKEYALLOCATE-HOLDER" D:X="?" EN^XQH D:X="??" LSTHOL D:X="???" USERFIL G HOLDER
7 S XQM=0 S:"'-"[$E(X,1) X=$E(X,2,999),XQM=1
8 ;I $E(X,1,2)'="G." S DIC=200,DIC(0)="EZM",DIC("S")="I $L($P(^(0),U,3))" D ^DIC K DIC W:(Y<0) " ??",$C(7) G:Y<0 HOLDER S XQI=+Y D EACH G HOLDER
9 I $E(X,1,2)'="G." S DIC=200,DIC(0)="EZM" D ^DIC K DIC W:(Y<0) " ??",$C(7) G:Y<0 HOLDER S XQI=+Y D EACH G HOLDER
10 S X=$E(X,3,999),XMDUZ=DUZ,DIC("S")="D:$P(^(0),U,2)=""PR"" CHK^XMA21",DIC="^XMB(3.8,",DIC(0)="EMZ" D ^DIC K DIC I Y<0 W " ??",$C(7) G HOLDER
11 ;S XQJ=0 F XQI=1:1 S XQJ=$O(^XMB(3.8,+Y,1,XQJ)) Q:XQJ'>0!(XQJ'=+XQJ) S XQI=+^(XQJ,0) I $L($P(^VA(200,XQI,0),U,3)) W !,$P(^(0),U,1) D EACH
12 S XQJ=0 F XQI=1:1 S XQJ=$O(^XMB(3.8,+Y,1,XQJ)) Q:XQJ'>0!(XQJ'=+XQJ) S XQI=+^(XQJ,0) W !,$P(^VA(200,XQI,0),U,1) D EACH
13 G HOLDER
14 ;
15EACH ;Check out each potential user
16 I 'XQBOSS,(XQI=DUZ) W !!,$C(7),"==> Sorry, you can't give yourself keys. See your IRM staff." Q
17 I XQM W $S($D(XQHOLD(XQI)):" Deleted from current list",1:$C(7)_" ?? Holder not on list") K XQHOLD(XQI) Q
18 S XQHOLD(XQI)=""
19 Q
20OK ;
21 D LSTKEY,LSTHOL
22 W !!,"You are ",$S(XQAL&XQDA:"delegating",XQAL:"allocating",XQDA:"removing delegated",1:"deallocating")," keys."
23OK1 R " Do you wish to proceed? YES// ",X:DTIME S:'$T X=U G:X[U OUT S:(X="") X="Y" I "YyNn"'[$E(X,1) W $C(7)," ??",!,"Please enter 'Y' or 'N'" G OK1
24 I $E(X,1)="N"!($E(X,1)="n") R !!,"Do you wish to start again? NO// ",X:DTIME S:'$T X=U G:X[U OUT S:(X="") X="N" G:X["Y"!(X["y") KEY^XQ6 G:"YyNn"'[$E(X,1) OK1 G OUT
25 ;
26ACT ;Run through list of keys
27 F XQK=0:0 S XQK=$O(XQKEY(XQK)) Q:XQK'>0 W !!,$P(^DIC(19.1,XQK,0),U,1)," being ",$S(XQAL&XQDA:"delegated to",XQAL:"assigned to:",1:"taken away from:") D ACT1
28 ;
29OUT ;Exit point
30 K %,DA,DIC,DIE,DR,XMDUZ,XQBOSS,XQKEY,XQAL,XQHOLD,XQI,XQJ,XQK,XQDA,XQSBNFDT,XQH,XQM,XQNM,X,Y
31 Q
32ACT1 ;Run through list of people
33 F XQM=0:0 S XQM=$O(XQHOLD(XQM)) Q:XQM'>0 D ACT2
34 Q
35ACT2 ;Add keys or DO ACT3 if we're removing them
36 N XQEND
37 S XQEND=""
38 S XQNM=$P(^VA(200,XQM,0),U,1) W !?5,XQNM I 'XQAL D ACT3 Q
39 I $D(^VA(200,XQM,$S(XQDA:52,1:51),XQK)) W ?30,"Person already holds key - no action taken" Q
40 D UNABLE^XQ6B(XQK,XQM,.XQEND) I XQEND=1 Q
41 S DIC(0)="NMQ",DIC("P")=$S(XQDA:"200.052PA",1:"200.051PA"),DIC="^VA(200,XQM,"_$S(XQDA:52,1:51)_",",DA(1)=XQM,X=XQK,DINUM=X D FILE^DICN Q
42ACT3 I '$D(^VA(200,XQM,$S(XQDA:52,1:51),XQK)) W ?30,"Person doesn't hold key - no action taken" Q
43 S DIK="^VA(200,XQM,"_$S(XQDA:52,1:51)_",",DA(1)=XQM,DA=XQK D ^DIK Q
44 Q
45LSTKEY ;
46 I $O(XQKEY(0))'>0 W !!,"You have not yet selected any keys." Q
47 W !!,"You've selected the following keys: ",! S XQJ=0,XQI=5 F XQK=0:1 S XQJ=$O(XQKEY(XQJ)) Q:XQJ'>0 W:'(XQK#XQI) ! W ?(XQK#XQI*15),$P(^DIC(19.1,XQJ,0),U,1)
48 Q
49LSTHOL ;
50 I $O(XQHOLD(0))'>0 W !!,"You have not yet selected any holders." Q
51 W !!,"You've selected the following holders: ",! S XQJ=0,XQI=3 F XQK=0:1 S XQJ=$O(XQHOLD(XQJ)) Q:XQJ'>0 W:'(XQK#XQI) ! W ?(XQK#XQI*26),$P(^VA(200,XQJ,0),U,1)
52 Q
53KEYFIL ;
54 I '$D(XQBOSS) S XQBOSS=0 S:(DUZ(0)="@"!($D(^XUSEC("XUMGR",DUZ)))) XQBOSS=1
55 S:'XQBOSS DIC("S")="I $D(^VA(200,DUZ,52,+Y,0))"
56 R !,"Do you want to see the KEY file? NO// ",X:DTIME S:'$T X="N" Q:X'["Y"&(X'["y") S X="?",DIC="^DIC(19.1,",DIC(0)="Q" D ^DIC K DIC
57 Q
58USERFIL ;
59 R !,"Do you want to see the current holders of a key? NO//",X:DTIME S:'$T X="N" G:X'["Y"&(X'["y") U0
60US0 S DIC=19.1,DIC(0)="AEQMZ" D ^DIC K DIC G:Y<0 U0 W !,"Holders are:" S XQII=0
61US1 S XQII=$O(^VA(200,"AB",+Y,XQII)) G:+XQII'>0 US0 W !?5,$S('$D(^VA(200,XQII,0)):XQII,1:$P(^VA(200,XQII,0),U)) G US1
62U0 R !,"Do you want to see the NEW PERSON file? NO// ",X:DTIME G:X'["Y"&(X'["y") U1 S X="?",DIC="^VA(200,",DIC(0)="Q" ;,DIC("S")="I $L($P(^(0),U,3))"
63 D ^DIC K DIC
64U1 R !,"Do you want to see the members of a Mail Group? NO// ",X:DTIME S:'$T X="N" Q:'(X["Y"!(X["y"))
65U2 S XMDUZ=DUZ,DIC("S")="D:$P(^(0),U,2)=""PR"" CHK^XMA21",DIC="^XMB(3.8,",DIC(0)="AEQMZ" D ^DIC K DIC Q:Y<0 W !,"Members are:" S XQII=0
66U3 S XQII=$O(^XMB(3.8,+Y,1,XQII)) G:+XQII'>0 U2 W !,?5 S X=^(XQII,0) W $S('X:X,'$D(^VA(200,X,0)):X,1:$P(^VA(200,X,0),U,1)) G U3
67 Q
Note: See TracBrowser for help on using the repository browser.