Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUS91

XUS91.m

Go to the documentation of this file.
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