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)
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 ---[H[J[2J[HXQ62 2193 printed Nov 22, 2024@17:15:02 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)
+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
