XQ6A.m

XQ6A ;SEA/AMF,SLC/CJS- BULK KEY DISTRIBUTION ;5:22 AM  19 Jun 2002 [ 07/29/2004   9:01 AM ]

 ;;8.0;KERNEL;**12,147**;Jul 10, 1995

HOLDER ;

 W !!,$S($O(XQHOLD(0))>0:"Another holder: ",1:"Holder of key: ") R X:DTIME S:'$T X=U G:X[U OUT

 I '$L(X) G:($O(XQHOLD(0))>0) OK W " ??",$C(7),!,"You have not yet selected any holders." G HOLDER

 I X["?" S XQH="XQKEYALLOCATE-HOLDER" D:X="?" EN^XQH D:X="??" LSTHOL D:X="???" USERFIL G HOLDER

 S XQM=0 S:"'-"[$E(X,1) X=$E(X,2,999),XQM=1

 ;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

 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

 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

 ;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

 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

 G HOLDER

 ;

EACH ;Check out each potential user

 I 'XQBOSS,(XQI=DUZ) W !!,$C(7),"==> Sorry, you can't give yourself keys.  See your IRM staff." Q

 I XQM W $S($D(XQHOLD(XQI)):"  Deleted from current list",1:$C(7)_" ??  Holder not on list") K XQHOLD(XQI) Q

 S XQHOLD(XQI)=""

 Q

OK ;

 D LSTKEY,LSTHOL

 W !!,"You are ",$S(XQAL&XQDA:"delegating",XQAL:"allocating",XQDA:"removing delegated",1:"deallocating")," keys."

OK1 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

 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

 ;

ACT ;Run through list of keys

 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

 ;

OUT ;Exit point

 K %,DA,DIC,DIE,DR,XMDUZ,XQBOSS,XQKEY,XQAL,XQHOLD,XQI,XQJ,XQK,XQDA,XQSBNFDT,XQH,XQM,XQNM,X,Y

 Q

ACT1 ;Run through list of people

 F XQM=0:0 S XQM=$O(XQHOLD(XQM)) Q:XQM'>0  D ACT2

 Q

ACT2 ;Add keys or DO ACT3 if we're removing them

 N XQEND

 S XQEND=""

 S XQNM=$P(^VA(200,XQM,0),U,1) W !?5,XQNM I 'XQAL D ACT3 Q

 I $D(^VA(200,XQM,$S(XQDA:52,1:51),XQK)) W ?30,"Person already holds key - no action taken" Q

 D UNABLE^XQ6B(XQK,XQM,.XQEND) I XQEND=1 Q

 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

ACT3 I '$D(^VA(200,XQM,$S(XQDA:52,1:51),XQK)) W ?30,"Person doesn't hold key - no action taken" Q

 S DIK="^VA(200,XQM,"_$S(XQDA:52,1:51)_",",DA(1)=XQM,DA=XQK D ^DIK Q

 Q

LSTKEY ;

 I $O(XQKEY(0))'>0 W !!,"You have not yet selected any keys." Q

 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)

 Q

LSTHOL ;

 I $O(XQHOLD(0))'>0 W !!,"You have not yet selected any holders." Q

 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)

 Q

KEYFIL ;

 I '$D(XQBOSS) S XQBOSS=0 S:(DUZ(0)="@"!($D(^XUSEC("XUMGR",DUZ)))) XQBOSS=1

 S:'XQBOSS DIC("S")="I $D(^VA(200,DUZ,52,+Y,0))"

 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

 Q

USERFIL ;

 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

US0 S DIC=19.1,DIC(0)="AEQMZ" D ^DIC K DIC G:Y<0 U0 W !,"Holders are:" S XQII=0

US1 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

U0 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))"

 D ^DIC K DIC

U1 R !,"Do you want to see the members of a Mail Group? NO// ",X:DTIME S:'$T X="N" Q:'(X["Y"!(X["y"))

U2 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

U3 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

 Q

XQ6A      ;SEA/AMF,SLC/CJS- BULK KEY DISTRIBUTION ;5:22 AM  19 Jun 2002 [ 07/29/2004   9:01 AM ]

 +1       ;;8.0;KERNEL;**12,147**;Jul 10, 1995

HOLDER    ;

 +1        WRITE !!,$SELECT($ORDER(XQHOLD(0))>0:"Another holder: ",1:"Holder of key: ")

           READ X:DTIME

           IF '$TEST

               SET X=U

           IF X[U

               GOTO OUT

 +2        IF '$LENGTH(X)

               IF ($ORDER(XQHOLD(0))>0)

                   GOTO OK

               WRITE " ??",$CHAR(7),!,"You have not yet selected any holders."

               GOTO HOLDER

 +3        IF X["?"

               SET XQH="XQKEYALLOCATE-HOLDER"

               IF X="?"

                   DO EN^XQH

               IF X="??"

                   DO LSTHOL

               IF X="???"

                   DO USERFIL

               GOTO HOLDER

 +4        SET XQM=0

           IF "'-"[$EXTRACT(X,1)

               SET X=$EXTRACT(X,2,999)

               SET XQM=1

 +5       ;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

 +6        IF $EXTRACT(X,1,2)'="G."

               SET DIC=200

               SET DIC(0)="EZM"

               DO ^DIC

               KILL DIC

               IF (Y<0)

                   WRITE " ??",$CHAR(7)

               IF Y<0

                   GOTO HOLDER

               SET XQI=+Y

               DO EACH

               GOTO HOLDER

 +7        SET X=$EXTRACT(X,3,999)

           SET XMDUZ=DUZ

           SET DIC("S")="D:$P(^(0),U,2)=""PR"" CHK^XMA21"

           SET DIC="^XMB(3.8,"

           SET DIC(0)="EMZ"

           DO ^DIC

           KILL DIC

           IF Y<0

               WRITE " ??",$CHAR(7)

               GOTO HOLDER

 +8       ;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

 +9        SET XQJ=0

           FOR XQI=1:1

               SET XQJ=$ORDER(^XMB(3.8,+Y,1,XQJ))

               IF XQJ'>0!(XQJ'=+XQJ)

                   QUIT 

               SET XQI=+^(XQJ,0)

               WRITE !,$PIECE(^VA(200,XQI,0),U,1)

               DO EACH

 +10       GOTO HOLDER

 +11      ;

EACH      ;Check out each potential user

 +1        IF 'XQBOSS

               IF (XQI=DUZ)

                   WRITE !!,$CHAR(7),"==> Sorry, you can't give yourself keys.  See your IRM staff."

                   QUIT 

 +2        IF XQM

               WRITE $SELECT($DATA(XQHOLD(XQI)):"  Deleted from current list",1:$CHAR(7)_" ??  Holder not on list")

               KILL XQHOLD(XQI)

               QUIT 

 +3        SET XQHOLD(XQI)=""

 +4        QUIT 

OK        ;

 +1        DO LSTKEY

           DO LSTHOL

 +2        WRITE !!,"You are ",$SELECT(XQAL&XQDA:"delegating",XQAL:"allocating",XQDA:"removing delegated",1:"deallocating")," keys."

OK1        READ "  Do you wish to proceed? YES// ",X:DTIME

           IF '$TEST

               SET X=U

           IF X[U

               GOTO OUT

           IF (X="")

               SET X="Y"

           IF "YyNn"'[$EXTRACT(X,1)

               WRITE $CHAR(7)," ??",!,"Please enter 'Y' or 'N'"

               GOTO OK1

 +1        IF $EXTRACT(X,1)="N"!($EXTRACT(X,1)="n")

               READ !!,"Do you wish to start again? NO// ",X:DTIME

               IF '$TEST

                   SET X=U

               IF X[U

                   GOTO OUT

               IF (X="")

                   SET X="N"

               IF X["Y"!(X["y")

                   GOTO KEY^XQ6

               IF "YyNn"'[$EXTRACT(X,1)

                   GOTO OK1

               GOTO OUT

 +2       ;

ACT       ;Run through list of keys

 +1        FOR XQK=0:0

               SET XQK=$ORDER(XQKEY(XQK))

               IF XQK'>0

                   QUIT 

               WRITE !!,$PIECE(^DIC(19.1,XQK,0),U,1)," being ",$SELECT(XQAL&XQDA:"delegated to",XQAL:"assigned to:",1:"taken away from:")

               DO ACT1

 +2       ;

OUT       ;Exit point

 +1        KILL %,DA,DIC,DIE,DR,XMDUZ,XQBOSS,XQKEY,XQAL,XQHOLD,XQI,XQJ,XQK,XQDA,XQSBNFDT,XQH,XQM,XQNM,X,Y

 +2        QUIT 

ACT1      ;Run through list of people

 +1        FOR XQM=0:0

               SET XQM=$ORDER(XQHOLD(XQM))

               IF XQM'>0

                   QUIT 

               DO ACT2

 +2        QUIT 

ACT2      ;Add keys or DO ACT3 if we're removing them

 +1        NEW XQEND

 +2        SET XQEND=""

 +3        SET XQNM=$PIECE(^VA(200,XQM,0),U,1)

           WRITE !?5,XQNM

           IF 'XQAL

               DO ACT3

               QUIT 

 +4        IF $DATA(^VA(200,XQM,$SELECT(XQDA:52,1:51),XQK))

               WRITE ?30,"Person already holds key - no action taken"

               QUIT 

 +5        DO UNABLE^XQ6B(XQK,XQM,.XQEND)

           IF XQEND=1

               QUIT 

 +6        SET DIC(0)="NMQ"

           SET DIC("P")=$SELECT(XQDA:"200.052PA",1:"200.051PA")

           SET DIC="^VA(200,XQM,"_$SELECT(XQDA:52,1:51)_","

           SET DA(1)=XQM

           SET X=XQK

           SET DINUM=X

           DO FILE^DICN

           QUIT 

ACT3       IF '$DATA(^VA(200,XQM,$SELECT(XQDA:52,1:51),XQK))

               WRITE ?30,"Person doesn't hold key - no action taken"

               QUIT 

 +1        SET DIK="^VA(200,XQM,"_$SELECT(XQDA:52,1:51)_","

           SET DA(1)=XQM

           SET DA=XQK

           DO ^DIK

           QUIT 

 +2        QUIT 

LSTKEY    ;

 +1        IF $ORDER(XQKEY(0))'>0

               WRITE !!,"You have not yet selected any keys."

               QUIT 

 +2        WRITE !!,"You've selected the following keys: ",!

           SET XQJ=0

           SET XQI=5

           FOR XQK=0:1

               SET XQJ=$ORDER(XQKEY(XQJ))

               IF XQJ'>0

                   QUIT 

               IF '(XQK#XQI)

                   WRITE !

               WRITE ?(XQK#XQI*15),$PIECE(^DIC(19.1,XQJ,0),U,1)

 +3        QUIT 

LSTHOL    ;

 +1        IF $ORDER(XQHOLD(0))'>0

               WRITE !!,"You have not yet selected any holders."

               QUIT 

 +2        WRITE !!,"You've selected the following holders: ",!

           SET XQJ=0

           SET XQI=3

           FOR XQK=0:1

               SET XQJ=$ORDER(XQHOLD(XQJ))

               IF XQJ'>0

                   QUIT 

               IF '(XQK#XQI)

                   WRITE !

               WRITE ?(XQK#XQI*26),$PIECE(^VA(200,XQJ,0),U,1)

 +3        QUIT 

KEYFIL    ;

 +1        IF '$DATA(XQBOSS)

               SET XQBOSS=0

               IF (DUZ(0)="@"!($DATA(^XUSEC("XUMGR",DUZ))))

                   SET XQBOSS=1

 +2        IF 'XQBOSS

               SET DIC("S")="I $D(^VA(200,DUZ,52,+Y,0))"

 +3        READ !,"Do you want to see the KEY file? NO// ",X:DTIME

           IF '$TEST

               SET X="N"

           IF X'["Y"&(X'["y")

               QUIT 

           SET X="?"

           SET DIC="^DIC(19.1,"

           SET DIC(0)="Q"

           DO ^DIC

           KILL DIC

 +4        QUIT 

USERFIL   ;

 +1        READ !,"Do you want to see the current holders of a key? NO//",X:DTIME

           IF '$TEST

               SET X="N"

           IF X'["Y"&(X'["y")

               GOTO U0

US0        SET DIC=19.1

           SET DIC(0)="AEQMZ"

           DO ^DIC

           KILL DIC

           IF Y<0

               GOTO U0

           WRITE !,"Holders are:"

           SET XQII=0

US1        SET XQII=$ORDER(^VA(200,"AB",+Y,XQII))

           IF +XQII'>0

               GOTO US0

           WRITE !?5,$SELECT('$DATA(^VA(200,XQII,0)):XQII,1:$PIECE(^VA(200,XQII,0),U))

           GOTO US1

U0        ;,DIC("S")="I $L($P(^(0),U,3))"

           READ !,"Do you want to see the NEW PERSON file? NO// ",X:DTIME

           IF X'["Y"&(X'["y")

               GOTO U1

           SET X="?"

           SET DIC="^VA(200,"

           SET DIC(0)="Q"

 +1        DO ^DIC

           KILL DIC

U1         READ !,"Do you want to see the members of a Mail Group? NO// ",X:DTIME

           IF '$TEST

               SET X="N"

           IF '(X["Y"!(X["y"))

               QUIT 

U2         SET XMDUZ=DUZ

           SET DIC("S")="D:$P(^(0),U,2)=""PR"" CHK^XMA21"

           SET DIC="^XMB(3.8,"

           SET DIC(0)="AEQMZ"

           DO ^DIC

           KILL DIC

           IF Y<0

               QUIT 

           WRITE !,"Members are:"

           SET XQII=0

U3         SET XQII=$ORDER(^XMB(3.8,+Y,1,XQII))

           IF +XQII'>0

               GOTO U2

           WRITE !,?5

           SET X=^(XQII,0)

           WRITE $SELECT('X:X,'$DATA(^VA(200,X,0)):X,1:$PIECE(^VA(200,X,0),U,1))

           GOTO U3

 +1        QUIT