- XQ32 ;SEA/JLI,MJM - LIST USERS WITH SPECIFIED MENU ;9/28/92 15:49;5/13/93 11:04 AM [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- ;;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
- XQ32 ;SEA/JLI,MJM - LIST USERS WITH SPECIFIED MENU ;9/28/92 15:49;5/13/93 11:04 AM [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- +2 ;;8.0;KERNEL;;Jul 10, 1995
- +3 ;
- +4 ;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
