- 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
