XQ32 ;SEA/JLI,MJM - LIST USERS WITH SPECIFIED MENU ;9/28/92 15:49;5/13/93 11:04 AM
;;8.0;KERNEL;;Jul 10, 1995
;
;Called by the option XQXREF 'List users with selected menu options'
PSM1 W ! S DIC=19,DIC(0)="AEQMZ",DIC("S")="I $D(^VA(200,""AD"",+Y))!$D(^VA(200,""AP"",+Y))" D ^DIC K DIC("S") I Y<0 S %=1 Q
S XQY1=Y,XQY2=Y(0)
S %ZIS="MQ" D ^%ZIS G:POP OUT I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^XQ32",ZTDESC="LIST HOLDERS OF OPTION AS PRIMARY AND SECONDARY MENUS",ZTSAVE("XQY1")="",ZTSAVE("XQY2")="" D QUEIT K ZTSK G OUT
;
DQ ; Entry point for queued job
S Y=XQY1,Y(0)=XQY2 K XQY1,XQY2
S $P(XQDSH,"-",132)="-" K ^TMP($J)
K XQHDR S XQHDR(1)="USERS ASSIGNED "_$P(Y(0),U,1)_" ["_$P(Y(0),U,2)_"]"
S XQHDR(2)="USER LAST SIGN-ON CREATOR"
S XQUI=0
S XQK="AP" I $D(^VA(200,XQK,+Y)) D PSM2 S XQP=1 D HDR W !!,$P(Y(0),U,2)," [",$P(Y(0),U,1),"]",!,"is the Primary Menu for ",XQJ," user",$S(XQJ>1:"s:",1:":"),! D PSM3 G:XQUI OUT D:$E(IOST,1)="C" CON
I 'XQUI S XQK="AD" I $D(^VA(200,XQK,+Y)) D PSM2 S XQP=1 D HDR W !!,$P(Y(0),U,2)," [",$P(Y(0),U,1),"]",!,"is the Secondary Menu for ",XQJ," user",$S(XQJ>1:"s:",1:"."),! D PSM3 G:XQUI OUT D:$E(IOST,1)="C" CON
;
OUT D ^%ZISC K %,XQUI,XQJ,XQLOG,XQCRT,XQS,XQE,XQK,XQLEN,XQNM,XQI,I,J,K,C,L,DIC,POP,X,XQDSH,XQENT,XQHDR,XQP,Y,ZISI,ZTDTH,ZTSAVE,ZTRTN,ZTDESC,%A1,S,XQFL
Q
PSM2 ;
K ^TMP($J,"U") S (XQJ,XQI)=0 F S XQI=$O(^VA(200,XQK,+Y,XQI)) Q:XQI'>0 S ^TMP($J,"U",$P(^VA(200,XQI,0),U,1))=XQI,XQJ=XQJ+1
Q
PSM3 ;
;S XQP=1 D HDR
S XQJ=0 F S XQJ=$O(^TMP($J,"U",XQJ)) Q:XQJ=""!XQUI D PSM4
Q
PSM4 ;
S XQI=^TMP($J,"U",XQJ) D:$Y+3>IOSL NWPG Q:XQUI
S XQLOG="",%="** no access **" S XQLOG=$S('$L($P(^VA(200,XQI,0),U,3)):%,'$D(^VA(200,XQI,.1))#2:%,'$L($P(^VA(200,XQI,.1),U,2)):%,1:"")
I XQLOG="" S %="** never **" S XQLOG=$S('$D(^VA(200,XQI,1.1))#2:%,'$L($P(^VA(200,XQI,1.1),U)):%,1:"")
I XQLOG="" I $L($P(^VA(200,XQI,1.1),U)) S %=+^(1.1),XQLOG=$E(%,4,5)_"/"_$E(%,6,7)_"/"_$E(%,2,3)
E S L="** never **"
S XQCRT="" I $D(^VA(200,XQI,1))#2,$L($P(^VA(200,XQI,1),U,8)) S %=$P(^(1),U,8) S XQCRT=$S('$D(^VA(200,%,0))#2:"",1:$P(^VA(200,%,0),U))
S:XQCRT="" XQCRT="** unknown **"
W !,XQJ,?33,XQLOG,?50,XQCRT
Q
NWPG I $E(IOST,1)="C" D CON Q:XQUI
D HDR Q
CON I '$D(DUOUT) W !!,"Press return to continue or '^' to escape " R X:DTIME S:'$T X=U S:X=U XQUI=1
Q
HDR W @IOF,!,XQHDR(1),?70,"PAGE ",XQP S XQP=XQP+1
W:$D(XQHDR(2)) !!,XQHDR(2) W:$D(XQHDR(3)) !,XQHDR(3)
W !,$E(XQDSH,1,IOM-1)
Q
QUEIT ;
S %DT="FTRXAQ",%DT("A")="QUEUE to run at what TIME: ",%dt("B")="NOW" D ^%DT Q:Y'>0 S X=Y D H^%DTC S ZTDTH=%H_","_%T D ^%ZTLOAD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQ32 2644 printed Nov 22, 2024@17:14:54 Page 2
XQ32 ;SEA/JLI,MJM - LIST USERS WITH SPECIFIED MENU ;9/28/92 15:49;5/13/93 11:04 AM
+1 ;;8.0;KERNEL;;Jul 10, 1995
+2 ;
+3 ;Called by the option XQXREF 'List users with selected menu options'
PSM1 WRITE !
SET DIC=19
SET DIC(0)="AEQMZ"
SET DIC("S")="I $D(^VA(200,""AD"",+Y))!$D(^VA(200,""AP"",+Y))"
DO ^DIC
KILL DIC("S")
IF Y<0
SET %=1
QUIT
+1 SET XQY1=Y
SET XQY2=Y(0)
+2 SET %ZIS="MQ"
DO ^%ZIS
if POP
GOTO OUT
IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="DQ^XQ32"
SET ZTDESC="LIST HOLDERS OF OPTION AS PRIMARY AND SECONDARY MENUS"
SET ZTSAVE("XQY1")=""
SET ZTSAVE("XQY2")=""
DO QUEIT
KILL ZTSK
GOTO OUT
+3 ;
DQ ; Entry point for queued job
+1 SET Y=XQY1
SET Y(0)=XQY2
KILL XQY1,XQY2
+2 SET $PIECE(XQDSH,"-",132)="-"
KILL ^TMP($JOB)
+3 KILL XQHDR
SET XQHDR(1)="USERS ASSIGNED "_$PIECE(Y(0),U,1)_" ["_$PIECE(Y(0),U,2)_"]"
+4 SET XQHDR(2)="USER LAST SIGN-ON CREATOR"
+5 SET XQUI=0
+6 SET XQK="AP"
IF $DATA(^VA(200,XQK,+Y))
DO PSM2
SET XQP=1
DO HDR
WRITE !!,$PIECE(Y(0),U,2)," [",$PIECE(Y(0),U,1),"]",!,"is the Primary Menu for ",XQJ," user",$SELECT(XQJ>1:"s:",1:":"),!
DO PSM3
if XQUI
GOTO OUT
if $EXTRACT(IOST,1)="C"
DO CON
+7 IF 'XQUI
SET XQK="AD"
IF $DATA(^VA(200,XQK,+Y))
DO PSM2
SET XQP=1
DO HDR
WRITE !!,$PIECE(Y(0),U,2)," [",$PIECE(Y(0),U,1),"]",!,"is the Secondary Menu for ",XQJ," user",$SELECT(XQJ>1:"s:",1:"."),!
DO PSM3
if XQUI
GOTO OUT
if $EXTRACT(IOST,1)="C"
DO CON
+8 ;
OUT DO ^%ZISC
KILL %,XQUI,XQJ,XQLOG,XQCRT,XQS,XQE,XQK,XQLEN,XQNM,XQI,I,J,K,C,L,DIC,POP,X,XQDSH,XQENT,XQHDR,XQP,Y,ZISI,ZTDTH,ZTSAVE,ZTRTN,ZTDESC,%A1,S,XQFL
+1 QUIT
PSM2 ;
+1 KILL ^TMP($JOB,"U")
SET (XQJ,XQI)=0
FOR
SET XQI=$ORDER(^VA(200,XQK,+Y,XQI))
if XQI'>0
QUIT
SET ^TMP($JOB,"U",$PIECE(^VA(200,XQI,0),U,1))=XQI
SET XQJ=XQJ+1
+2 QUIT
PSM3 ;
+1 ;S XQP=1 D HDR
+2 SET XQJ=0
FOR
SET XQJ=$ORDER(^TMP($JOB,"U",XQJ))
if XQJ=""!XQUI
QUIT
DO PSM4
+3 QUIT
PSM4 ;
+1 SET XQI=^TMP($JOB,"U",XQJ)
if $Y+3>IOSL
DO NWPG
if XQUI
QUIT
+2 SET XQLOG=""
SET %="** no access **"
SET XQLOG=$SELECT('$LENGTH($PIECE(^VA(200,XQI,0),U,3)):%,'$DATA(^VA(200,XQI,.1))#2:%,'$LENGTH($PIECE(^VA(200,XQI,.1),U,2)):%,1:"")
+3 IF XQLOG=""
SET %="** never **"
SET XQLOG=$SELECT('$DATA(^VA(200,XQI,1.1))#2:%,'$LENGTH($PIECE(^VA(200,XQI,1.1),U)):%,1:"")
+4 IF XQLOG=""
IF $LENGTH($PIECE(^VA(200,XQI,1.1),U))
SET %=+^(1.1)
SET XQLOG=$EXTRACT(%,4,5)_"/"_$EXTRACT(%,6,7)_"/"_$EXTRACT(%,2,3)
+5 IF '$TEST
SET L="** never **"
+6 SET XQCRT=""
IF $DATA(^VA(200,XQI,1))#2
IF $LENGTH($PIECE(^VA(200,XQI,1),U,8))
SET %=$PIECE(^(1),U,8)
SET XQCRT=$SELECT('$DATA(^VA(200,%,0))#2:"",1:$PIECE(^VA(200,%,0),U))
+7 if XQCRT=""
SET XQCRT="** unknown **"
+8 WRITE !,XQJ,?33,XQLOG,?50,XQCRT
+9 QUIT
NWPG IF $EXTRACT(IOST,1)="C"
DO CON
if XQUI
QUIT
+1 DO HDR
QUIT
CON IF '$DATA(DUOUT)
WRITE !!,"Press return to continue or '^' to escape "
READ X:DTIME
if '$TEST
SET X=U
if X=U
SET XQUI=1
+1 QUIT
HDR WRITE @IOF,!,XQHDR(1),?70,"PAGE ",XQP
SET XQP=XQP+1
+1 if $DATA(XQHDR(2))
WRITE !!,XQHDR(2)
if $DATA(XQHDR(3))
WRITE !,XQHDR(3)
+2 WRITE !,$EXTRACT(XQDSH,1,IOM-1)
+3 QUIT
QUEIT ;
+1 SET %DT="FTRXAQ"
SET %DT("A")="QUEUE to run at what TIME: "
SET %dt("B")="NOW"
DO ^%DT
if Y'>0
QUIT
SET X=Y
DO H^%DTC
SET ZTDTH=%H_","_%T
DO ^%ZTLOAD
+2 QUIT
