XUS91 ;SF/STAFF - REPORT OF USERS SIGNED ON ; [2/20/03 9:19am]
;;8.0;KERNEL;**18,65,273,1011,1016**;Jul 10, 1995;Build 5
;routine contains IHS mod
S U="^",XUSUCI="" I $D(^%ZOSF("UCI")) X ^%ZOSF("UCI") S XUSUCI=Y
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
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,18)_" *Tasked"
S ^TMP($J,XQUN,XQJN)=XQV_U_XQK
Q
LIST ;
D:$Y>19 NEWPG Q:XQUI S (X,Y)=XQJN,X1=16
;BEGIN IHS MOD
;S:X>32768 Y=$$CNV^XLFUTL(X,16) ;TASSC/MFD
;END IHS MOD
W !,Y,?12,$E(XQUN,1,19),?33,$P(XQV,U,1),?42,$P(XQV,U,2) W:$X>49 ! W ?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 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 !!,$C(7),"This user has no primary menu.",!,"NOW..Returning to your own identity." Q
N XUSKFLG S XUSKFLG=$$CHK(+Y)
I XUSKFLG=-1 D Q
.W !!," ==>Sorry, Primary Menu for this user is locked."
.W !," NOW..Returning to your own identity."
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." L ;Clear all locks
G ^XQ
CHK(Y) ;
N XUSPM,XUSPM1,XUSPM2,I,XUSKFLG
S XUSKFLG=-1
S XUSPM=$P($G(^VA(200,+Y,201)),"^")
;get Key of Primary Menu
S XUSPM1=$P($G(^DIC(19,XUSPM,0)),"^",6) Q:(XUSPM1="") 0
S XUSPM2=0 F I=0:0 S XUSPM2=$O(^VA(200,+Y,51,XUSPM2)) Q:XUSPM2'>0 D
.I $P($G(^DIC(19.1,XUSPM2,0)),"^")=XUSPM1 S XUSKFLG=0
Q XUSKFLG
XUS91 ;SF/STAFF - REPORT OF USERS SIGNED ON ; [2/20/03 9:19am]
+1 ;;8.0;KERNEL;**18,65,273,1011,1016**;Jul 10, 1995;Build 5
+2 ;routine contains IHS mod
+3 SET U="^"
SET XUSUCI=""
IF $DATA(^%ZOSF("UCI"))
XECUTE ^%ZOSF("UCI")
SET XUSUCI=Y
+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 GOTO END
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,18)_" *Tasked"
+6 SET ^TMP($JOB,XQUN,XQJN)=XQV_U_XQK
+7 QUIT
LIST ;
+1 IF $Y>19
DO NEWPG
IF XQUI
QUIT
SET (X,Y)=XQJN
SET X1=16
+2 ;BEGIN IHS MOD
+3 ;S:X>32768 Y=$$CNV^XLFUTL(X,16) ;TASSC/MFD
+4 ;END IHS MOD
+5 WRITE !,Y,?12,$EXTRACT(XQUN,1,19),?33,$PIECE(XQV,U,1),?42,$PIECE(XQV,U,2)
IF $X>49
WRITE !
WRITE ?50,$PIECE(XQV,U,3,99)
+6 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 KILL XQI,XQJN,XQUN,XUSUCI,ZJ,XQJ,XQK,XQUI,XQPG,XQHDR,XQV,D,J,X,XQM,XQT,Y,Z,^TMP($JOB)
+2 QUIT
+3 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 !!,$CHAR(7),"This user has no primary menu.",!,"NOW..Returning to your own identity."
QUIT
+4 NEW XUSKFLG
SET XUSKFLG=$$CHK(+Y)
+5 IF XUSKFLG=-1
Begin DoDot:1
+6 WRITE !!," ==>Sorry, Primary Menu for this user is locked."
+7 WRITE !," NOW..Returning to your own identity."
End DoDot:1
QUIT
+8 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
+9 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 ;Clear all locks
WRITE !!,"OK... Returning to your own identity."
LOCK
+3 GOTO ^XQ
CHK(Y) ;
+1 NEW XUSPM,XUSPM1,XUSPM2,I,XUSKFLG
+2 SET XUSKFLG=-1
+3 SET XUSPM=$PIECE($GET(^VA(200,+Y,201)),"^")
+4 ;get Key of Primary Menu
+5 SET XUSPM1=$PIECE($GET(^DIC(19,XUSPM,0)),"^",6)
IF (XUSPM1="")
QUIT 0
+6 SET XUSPM2=0
FOR I=0:0
SET XUSPM2=$ORDER(^VA(200,+Y,51,XUSPM2))
IF XUSPM2'>0
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(^DIC(19.1,XUSPM2,0)),"^")=XUSPM1
SET XUSKFLG=0
End DoDot:1
+8 QUIT XUSKFLG
