XQ62.m

XQ62 ;SEA/MJM - Generalized file look-up utility ;8/2/89  09:53;5/13/93  11:53 AM

 ;;8.0;KERNEL;;Jul 10, 1995

 S U="^" K ^TMP($J)

MENU W !!,?5,"Please choose the information you would like to examine by number",!!,?10,$S($D(XQ6):"1.  The key file",1:"1.  Help Frame File"),!!,?10,"2.  Current ",$S($D(XQ6):"holders of a key",1:"editors of a help frame")

 W !!,?10,"3.  The User File",!!,?10,"4.  A mail group"

 ;

ASK ;Get user's response, check it, and branch to subroutine

 R !!,?5,"Enter a number or '^' to quit: ",X:DTIME S:'$T X=U G:'$L(X)!(X=U) OUT I X<1!(X>4)!(X'?1N) W " ??",*7,!!,"Please enter the number corresponding to the information you seek or '^' to quit." G ASK

 W !!

 I X=3 G USER

 I X=4 G MAILG

 I $D(XQ6)&(X=1) S DIC="^DIC(19.1,",DIC(0)="AEMNQ",DIC("A")="     What key would you like to see? " D ^DIC G:Y<0 OUT S DA=+Y D EN^DIQ G OUT

 I X=1 S DIC="^DIC(9.2,",DIC(0)="AEMNQ",DIC("A")="     What help frame would you like to see? " D ^DIC G:Y<0 OUT S DA=+Y D EN^DIQ G OUT

 I $D(XQ6)&(X=2) S DIC="^DIC(19.1,",DIC(0)="AEMNQZ",DIC("A")="     Holders of what key? " D ^DIC G:Y<0 OUT S I=0 F XQL=0:1 S I=$O(^DIC(19.1,+Y,2,I)) G:I="" PRINT S XQU=+^(I,0) S:$D(^VA(200,+XQU,0)) X=$P(^(0),U),^TMP($J,X)=""

 I X=2 S DIC="^DIC(9.2,",DIC(0)="AEMNQZ",DIC("A")="     Editors of which help frame? " D ^DIC G:Y<0 OUT S I=0 F XQL=0:1 S I=$O(^DIC(9.2,+Y,4,"AB",I)) G:I="" PRINT S:$D(^VA(200,+I,0)) X=$P(^(0),U,1),^TMP($J,X)=""

 W !!,"Something's wrong...what was it you wanted again? " G ASK

 Q

USER ;Look at the User File

 S DIC=200,X="?",DIC(0)="AEMNQ",DIC("S")="I $L($P(^(0),U,3))",DIC("A")="     Which user would you like to examine? " D ^DIC G:Y<0 OUT S DA=+Y D EN^DIQ G OUT

 Q

MAILG ;Examine a mail group

 S XMDUZ=DUZ,DIC="^XMB(3.8,",DIC(0)="AEQMZ",DIC("A")="     Which mail group? " D ^DIC G:Y<0 OUT W !!," Members are: " S I=0 W !

 F XQL=0:1 S I=$O(^XMB(3.8,+Y,1,I)) Q:'I  S XQU=+^(I,0) S:$D(^VA(200,+XQU,0)) X=$P(^VA(200,+XQU,0),U),^TMP($J,X)=""

PRINT S XQLL=XQL,I=""

 I $O(^TMP($J,I))="" W !!,?5," There is no one listed in the file.",!! G OUT

 F XQL=0:XQLL S I=$O(^TMP($J,I)) Q:I=""  W !,?5,I

 ;

OUT ;Clean up and return

 K DA,DIC,I,X,Y,XQL,XQLL,XQU

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XQ62   2193     printed  Mar 13, 2025@21:09:48                                                                                                                                                                                                        Page 2

XQ62      ;SEA/MJM - Generalized file look-up utility ;8/2/89  09:53;5/13/93  11:53 AM

 +1       ;;8.0;KERNEL;;Jul 10, 1995

 +2        SET U="^"

           KILL ^TMP($JOB)

MENU       WRITE !!,?5,"Please choose the information you would like to examine by number",!!,?10,$SELECT($DATA(XQ6):"1.  The key file",1:"1.  Help Frame File"),!!,?10,"2.  Current ",$SELECT($DATA(XQ6):"holders of a key",1:"editors of a help frame")

 +1        WRITE !!,?10,"3.  The User File",!!,?10,"4.  A mail group"

 +2       ;

ASK       ;Get user's response, check it, and branch to subroutine

 +1        READ !!,?5,"Enter a number or '^' to quit: ",X:DTIME

           if '$TEST

               SET X=U

           if '$LENGTH(X)!(X=U)

               GOTO OUT

           IF X<1!(X>4)!(X'?1N)

               WRITE " ??",*7,!!,"Please enter the number corresponding to the information you seek or '^' to quit."

               GOTO ASK

 +2        WRITE !!

 +3        IF X=3

               GOTO USER

 +4        IF X=4

               GOTO MAILG

 +5        IF $DATA(XQ6)&(X=1)

               SET DIC="^DIC(19.1,"

               SET DIC(0)="AEMNQ"

               SET DIC("A")="     What key would you like to see? "

               DO ^DIC

               if Y<0

                   GOTO OUT

               SET DA=+Y

               DO EN^DIQ

               GOTO OUT

 +6        IF X=1

               SET DIC="^DIC(9.2,"

               SET DIC(0)="AEMNQ"

               SET DIC("A")="     What help frame would you like to see? "

               DO ^DIC

               if Y<0

                   GOTO OUT

               SET DA=+Y

               DO EN^DIQ

               GOTO OUT

 +7        IF $DATA(XQ6)&(X=2)

               SET DIC="^DIC(19.1,"

               SET DIC(0)="AEMNQZ"

               SET DIC("A")="     Holders of what key? "

               DO ^DIC

               if Y<0

                   GOTO OUT

               SET I=0

               FOR XQL=0:1

                   SET I=$ORDER(^DIC(19.1,+Y,2,I))

                   if I=""

                       GOTO PRINT

                   SET XQU=+^(I,0)

                   if $DATA(^VA(200,+XQU,0))

                       SET X=$PIECE(^(0),U)

                       SET ^TMP($JOB,X)=""

 +8        IF X=2

               SET DIC="^DIC(9.2,"

               SET DIC(0)="AEMNQZ"

               SET DIC("A")="     Editors of which help frame? "

               DO ^DIC

               if Y<0

                   GOTO OUT

               SET I=0

               FOR XQL=0:1

                   SET I=$ORDER(^DIC(9.2,+Y,4,"AB",I))

                   if I=""

                       GOTO PRINT

                   if $DATA(^VA(200,+I,0))

                       SET X=$PIECE(^(0),U,1)

                       SET ^TMP($JOB,X)=""

 +9        WRITE !!,"Something's wrong...what was it you wanted again? "

           GOTO ASK

 +10       QUIT 

USER      ;Look at the User File

 +1        SET DIC=200

           SET X="?"

           SET DIC(0)="AEMNQ"

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

           SET DIC("A")="     Which user would you like to examine? "

           DO ^DIC

           if Y<0

               GOTO OUT

           SET DA=+Y

           DO EN^DIQ

           GOTO OUT

 +2        QUIT 

MAILG     ;Examine a mail group

 +1        SET XMDUZ=DUZ

           SET DIC="^XMB(3.8,"

           SET DIC(0)="AEQMZ"

           SET DIC("A")="     Which mail group? "

           DO ^DIC

           if Y<0

               GOTO OUT

           WRITE !!," Members are: "

           SET I=0

           WRITE !

 +2        FOR XQL=0:1

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

               if 'I

                   QUIT 

               SET XQU=+^(I,0)

               if $DATA(^VA(200,+XQU,0))

                   SET X=$PIECE(^VA(200,+XQU,0),U)

                   SET ^TMP($JOB,X)=""

PRINT      SET XQLL=XQL

           SET I=""

 +1        IF $ORDER(^TMP($JOB,I))=""

               WRITE !!,?5," There is no one listed in the file.",!!

               GOTO OUT

 +2        FOR XQL=0:XQLL

               SET I=$ORDER(^TMP($JOB,I))

               if I=""

                   QUIT 

               WRITE !,?5,I

 +3       ;

OUT       ;Clean up and return

 +1        KILL DA,DIC,I,X,Y,XQL,XQLL,XQU

 +2        QUIT