XUS911 ;SF/STAFF - REPORT OF USERS SIGNED ON ;1/22/93 14:26 [ 04/02/2003 8:29 AM ]
;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
;;7.1;KERNEL;;May 11, 1993
;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/ANMC/MWR; IHS/ANMC/CLS
;;IHS/ANMC/MWR LOOKUP FOR A SINGLE USER
;
S U="^",XUSUCI="" I $D(^%ZOSF("UCI")) X ^%ZOSF("UCI") S XUSUCI=Y
;
BEGIN ; -- begin ihs mods ;IHS/ANMC/MWR
F D LOOKUP Q:Y=-1
D END
Q
;
LOOKUP ;
W !!
S DIC=200,DIC(0)="QEMA"
S DIC("A")="Select the user you wish to check on: "
D ^DIC
Q:Y=-1
S MWRUSR=$P(Y,U,2)
D CODES
Q
;
CODES ;
S:'$D(DTIME) DTIME=300
; -- end ihs mods ;IHS/ANMC/MWR
;
S XQHDR=" USER STATUS REPORT "_XUSUCI
S %H=$H D YMD^%DTC S DT=X
W !,"Lookup pass " K ^TMP($J) S XQJN=0
F I=0:0 S XQJN=$O(^XUTL("XQ",XQJN)) Q:XQJN'>0 S X=XQJN X ^%ZOSF("JOBPARAM") S XQK=$P(Y,U,1) D:(XUSUCI=XQK)!(XQK="UNKNOWN") PASS1
S IOP="" D ^%ZIS K IOP S XQPG=0,XQUI=0 D NEWPG
PRINT S XQUN=-1 F I=0:0 S XQUN=$O(^TMP($J,XQUN)) Q:(XQUN="")!XQUI S XQJN=0 F J=0:0 S XQJN=$O(^TMP($J,XQUN,XQJN)) Q:(XQJN="")!XQUI S XQV=^(XQJN) D LIST
;G END
Q ;IHS/ANMC/MWR
;
PASS1 ;
W "." S XQUN="UNKNOWN" I $D(^XUTL("XQ",XQJN,"DUZ")) S XQUN=^("DUZ"),XQUN=$S($D(^VA(200,XQUN,0)):$P(^(0),U,1),1:"UNKNOWN")
S XQV="UNKNOWN" I $D(^XUTL("XQ",XQJN,0)) S XQV=$P(^(0),".",2)_"00",XQV=$E(XQV,1,2)_":"_$E(XQV,3,4)
S XQV=XQV_U_$S('$D(^XUTL("XQ",XQJN,"IO")):"UNKNOWN",1:^("IO"))
S XQK="UNKNOWN" I $D(^XUTL("XQ",XQJN,"T")),^("T") S XQK=^("T") I $D(^(XQK)) S XQK=$E($P(^(XQK),U,3),1,29)
I XQK="UNKNOWN",$D(^XUTL("XQ",XQJN,"ZTSK")) S XQJ=^("ZTSK") S:$D(^("XQM")) XQJ=$P(^DIC(19,^("XQM"),0),U,2) S XQK=$E(XQJ,1,19)_" *Tasked"
S ^TMP($J,XQUN,XQJN)=XQV_U_XQK
Q
LIST ;
;D:$Y>19 NEWPG Q:XQUI S (X,Y)=XQJN,X1=16 I X>127 D CNV^XTBASE ;IHS/ANMC/CLS commented out
D:$Y>19 NEWPG Q:XQUI S (X,Y)=XQJN,X1=16;;IHS/ANMC/CLS 11/4/94 per Floyd Dennis so job # > 127 doesn't print in hex
Q:MWRUSR'=XQUN ;IHS/ANMC/MWR
W !,Y,?12,$E(XQUN,1,19),?33,$P(XQV,U,1),?42,$P(XQV,U,2),?50,$P(XQV,U,3,99)
Q
NEWPG ;
I XQPG,$E(IOST,1)="C" D CON S XQUI=(X="^") Q:XQUI
D HDR Q
CON ;
W !!,"Press return to continue or '^' to escape " R X:DTIME S:'$T X=U
Q
HDR ;
W @IOF S XQPG=XQPG+1
S Y=$P($H,",",2)\60,Y=(Y#60/100+(Y\60)/100+DT) D DT^DIO2
W ?22,XQHDR,?71,"PAGE ",XQPG
W !!,"JOB NUMBER USER NAME TIME ON DEVICE CURRENT MENU OPTION"
W !,"---------- ------------------- ------- ------ ------------------------------"
Q
END ;
K MWRUSR ;IHS/ANMC/MWR
K XQI,XQJN,XQUN,XUSUCI,ZJ,XQJ,XQK,XQUI,XQPG,XQHDR,XQV,D,J,X,XQM,XQT,Y,Z,^TMP($J)
Q
Q
TESTM ;
W !!,"This option will allow you to simulate signing on as another user to test their",!,"menus and keys. You can step through menus, but cannot execute options.",!,"Return to your own identity by entering a '*'.",!
S DIC=200,DIC(0)="AEQMZ" D ^DIC Q:Y<0
I $S('$D(^VA(200,+Y,201)):1,($P(^VA(200,+Y,201),U,1)=""):1,1:0) W !!,*7,"This user has no primary menu." Q
S XQY=^VA(200,+Y,201),DUZ("SAV")=DUZ_U_DUZ(0),DUZ=+Y,DUZ(0)=$P(Y(0),U,4),%=$P(^VA(200,+Y,0),U,1),DUZ("SAV")=DUZ("SAV")_U_$P(%,",",2)_" "_$P(%,",",1) G ^XQ
Q
TESTN ;
S DUZ=+DUZ("SAV"),DUZ(0)=$P(DUZ("SAV"),U,2),XQY=+^VA(200,DUZ,201) K DUZ("SAV"),XQUR,XMDUZ
W !!,"OK... Returning to your own identity."
G ^XQ
XUS911 ;SF/STAFF - REPORT OF USERS SIGNED ON ;1/22/93 14:26 [ 04/02/2003 8:29 AM ]
+1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
+2 ;;7.1;KERNEL;;May 11, 1993
+3 ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/ANMC/MWR; IHS/ANMC/CLS
+4 ;;IHS/ANMC/MWR LOOKUP FOR A SINGLE USER
+5 ;
+6 SET U="^"
SET XUSUCI=""
IF $DATA(^%ZOSF("UCI"))
XECUTE ^%ZOSF("UCI")
SET XUSUCI=Y
+7 ;
BEGIN ; -- begin ihs mods ;IHS/ANMC/MWR
+1 FOR
DO LOOKUP
IF Y=-1
QUIT
+2 DO END
+3 QUIT
+4 ;
LOOKUP ;
+1 WRITE !!
+2 SET DIC=200
SET DIC(0)="QEMA"
+3 SET DIC("A")="Select the user you wish to check on: "
+4 DO ^DIC
+5 IF Y=-1
QUIT
+6 SET MWRUSR=$PIECE(Y,U,2)
+7 DO CODES
+8 QUIT
+9 ;
CODES ;
+1 IF '$DATA(DTIME)
SET DTIME=300
+2 ; -- end ihs mods ;IHS/ANMC/MWR
+3 ;
+4 SET XQHDR=" USER STATUS REPORT "_XUSUCI
+5 SET %H=$HOROLOG
DO YMD^%DTC
SET DT=X
+6 WRITE !,"Lookup pass "
KILL ^TMP($JOB)
SET XQJN=0
+7 FOR I=0:0
SET XQJN=$ORDER(^XUTL("XQ",XQJN))
IF XQJN'>0
QUIT
SET X=XQJN
XECUTE ^%ZOSF("JOBPARAM")
SET XQK=$PIECE(Y,U,1)
IF (XUSUCI=XQK)!(XQK="UNKNOWN")
DO PASS1
+8 SET IOP=""
DO ^%ZIS
KILL IOP
SET XQPG=0
SET XQUI=0
DO NEWPG
PRINT SET XQUN=-1
FOR I=0:0
SET XQUN=$ORDER(^TMP($JOB,XQUN))
IF (XQUN="")!XQUI
QUIT
SET XQJN=0
FOR J=0:0
SET XQJN=$ORDER(^TMP($JOB,XQUN,XQJN))
IF (XQJN="")!XQUI
QUIT
SET XQV=^(XQJN)
DO LIST
+1 ;G END
+2 ;IHS/ANMC/MWR
QUIT
+3 ;
PASS1 ;
+1 WRITE "."
SET XQUN="UNKNOWN"
IF $DATA(^XUTL("XQ",XQJN,"DUZ"))
SET XQUN=^("DUZ")
SET XQUN=$SELECT($DATA(^VA(200,XQUN,0)):$PIECE(^(0),U,1),1:"UNKNOWN")
+2 SET XQV="UNKNOWN"
IF $DATA(^XUTL("XQ",XQJN,0))
SET XQV=$PIECE(^(0),".",2)_"00"
SET XQV=$EXTRACT(XQV,1,2)_":"_$EXTRACT(XQV,3,4)
+3 SET XQV=XQV_U_$SELECT('$DATA(^XUTL("XQ",XQJN,"IO")):"UNKNOWN",1:^("IO"))
+4 SET XQK="UNKNOWN"
IF $DATA(^XUTL("XQ",XQJN,"T"))
IF ^("T")
SET XQK=^("T")
IF $DATA(^(XQK))
SET XQK=$EXTRACT($PIECE(^(XQK),U,3),1,29)
+5 IF XQK="UNKNOWN"
IF $DATA(^XUTL("XQ",XQJN,"ZTSK"))
SET XQJ=^("ZTSK")
IF $DATA(^("XQM"))
SET XQJ=$PIECE(^DIC(19,^("XQM"),0),U,2)
SET XQK=$EXTRACT(XQJ,1,19)_" *Tasked"
+6 SET ^TMP($JOB,XQUN,XQJN)=XQV_U_XQK
+7 QUIT
LIST ;
+1 ;D:$Y>19 NEWPG Q:XQUI S (X,Y)=XQJN,X1=16 I X>127 D CNV^XTBASE ;IHS/ANMC/CLS commented out
+2 ;;IHS/ANMC/CLS 11/4/94 per Floyd Dennis so job # > 127 doesn't print in hex
IF $Y>19
DO NEWPG
IF XQUI
QUIT
SET (X,Y)=XQJN
SET X1=1
+3 ;IHS/ANMC/MWR
IF MWRUSR'=XQUN
QUIT
+4 WRITE !,Y,?12,$EXTRACT(XQUN,1,19),?33,$PIECE(XQV,U,1),?42,$PIECE(XQV,U,2),?50,$PIECE(XQV,U,3,99)
+5 QUIT
NEWPG ;
+1 IF XQPG
IF $EXTRACT(IOST,1)="C"
DO CON
SET XQUI=(X="^")
IF XQUI
QUIT
+2 DO HDR
QUIT
CON ;
+1 WRITE !!,"Press return to continue or '^' to escape "
READ X:DTIME
IF '$TEST
SET X=U
+2 QUIT
HDR ;
+1 WRITE @IOF
SET XQPG=XQPG+1
+2 SET Y=$PIECE($HOROLOG,",",2)\60
SET Y=(Y#60/100+(Y\60)/100+DT)
DO DT^DIO2
+3 WRITE ?22,XQHDR,?71,"PAGE ",XQPG
+4 WRITE !!,"JOB NUMBER USER NAME TIME ON DEVICE CURRENT MENU OPTION"
+5 WRITE !,"---------- ------------------- ------- ------ ------------------------------"
+6 QUIT
END ;
+1 ;IHS/ANMC/MWR
KILL MWRUSR
+2 KILL XQI,XQJN,XQUN,XUSUCI,ZJ,XQJ,XQK,XQUI,XQPG,XQHDR,XQV,D,J,X,XQM,XQT,Y,Z,^TMP($JOB)
+3 QUIT
+4 QUIT
TESTM ;
+1 WRITE !!,"This option will allow you to simulate signing on as another user to test their",!,"menus and keys. You can step through menus, but cannot execute options.",!,"Return to your own identity by entering a '*'.",!
+2 SET DIC=200
SET DIC(0)="AEQMZ"
DO ^DIC
IF Y<0
QUIT
+3 IF $SELECT('$DATA(^VA(200,+Y,201)):1,($PIECE(^VA(200,+Y,201),U,1)=""):1,1:0)
WRITE !!,*7,"This user has no primary menu."
QUIT
+4 SET XQY=^VA(200,+Y,201)
SET DUZ("SAV")=DUZ_U_DUZ(0)
SET DUZ=+Y
SET DUZ(0)=$PIECE(Y(0),U,4)
SET %=$PIECE(^VA(200,+Y,0),U,1)
SET DUZ("SAV")=DUZ("SAV")_U_$PIECE(%,",",2)_" "_$PIECE(%,",",1)
GOTO ^XQ
+5 QUIT
TESTN ;
+1 SET DUZ=+DUZ("SAV")
SET DUZ(0)=$PIECE(DUZ("SAV"),U,2)
SET XQY=+^VA(200,DUZ,201)
KILL DUZ("SAV"),XQUR,XMDUZ
+2 WRITE !!,"OK... Returning to your own identity."
+3 GOTO ^XQ
