source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUS91.m@ 738

Last change on this file since 738 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1XUS91 ;SF/STAFF - REPORT OF USERS SIGNED ON ; [2/20/03 9:19am]
2 ;;8.0;KERNEL;**18,65,273**;Jul 10, 1995
3 S U="^",XUSUCI="" I $D(^%ZOSF("UCI")) X ^%ZOSF("UCI") S XUSUCI=Y
4 S XQHDR=" USER STATUS REPORT "_XUSUCI
5 S %H=$H D YMD^%DTC S DT=X
6 W !,"Lookup pass " K ^TMP($J) S XQJN=0
7 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
8 S IOP="" D ^%ZIS K IOP S XQPG=0,XQUI=0 D NEWPG
9PRINT 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
10 G END
11PASS1 ;
12 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")
13 S XQV="UNKNOWN" I $D(^XUTL("XQ",XQJN,0)) S XQV=$P(^(0),".",2)_"00",XQV=$E(XQV,1,2)_":"_$E(XQV,3,4)
14 S XQV=XQV_U_$S('$D(^XUTL("XQ",XQJN,"IO")):"UNKNOWN",1:^("IO"))
15 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)
16 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"
17 S ^TMP($J,XQUN,XQJN)=XQV_U_XQK
18 Q
19LIST ;
20 D:$Y>19 NEWPG Q:XQUI S (X,Y)=XQJN,X1=16 S:X>32768 Y=$$CNV^XLFUTL(X,16)
21 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)
22 Q
23NEWPG ;
24 I XQPG,$E(IOST,1)="C" D CON S XQUI=(X="^") Q:XQUI
25 D HDR Q
26CON ;
27 W !!,"Press return to continue or '^' to escape " R X:DTIME S:'$T X=U
28 Q
29HDR ;
30 W @IOF S XQPG=XQPG+1
31 S Y=$P($H,",",2)\60,Y=(Y#60/100+(Y\60)/100+DT) D DT^DIO2
32 W ?22,XQHDR,?71,"PAGE ",XQPG
33 W !!,"JOB NUMBER USER NAME TIME ON DEVICE CURRENT MENU OPTION"
34 W !,"---------- ------------------- ------- ------ ------------------------------"
35 Q
36END ;
37 K XQI,XQJN,XQUN,XUSUCI,ZJ,XQJ,XQK,XQUI,XQPG,XQHDR,XQV,D,J,X,XQM,XQT,Y,Z,^TMP($J)
38 Q
39 Q
40TESTM ;
41 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 '*'.",!
42 S DIC=200,DIC(0)="AEQMZ" D ^DIC Q:Y<0
43 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
44 N XUSKFLG S XUSKFLG=$$CHK(+Y)
45 I XUSKFLG=-1 D Q
46 .W !!," ==>Sorry, Primary Menu for this user is locked."
47 .W !," NOW..Returning to your own identity."
48 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
49 Q
50TESTN ;
51 S DUZ=+DUZ("SAV"),DUZ(0)=$P(DUZ("SAV"),U,2),XQY=+^VA(200,DUZ,201) K DUZ("SAV"),XQUR,XMDUZ
52 W !!,"OK... Returning to your own identity." L ;Clear all locks
53 G ^XQ
54CHK(Y) ;
55 N XUSPM,XUSPM1,XUSPM2,I,XUSKFLG
56 S XUSKFLG=-1
57 S XUSPM=$P($G(^VA(200,+Y,201)),"^")
58 ;get Key of Primary Menu
59 S XUSPM1=$P($G(^DIC(19,XUSPM,0)),"^",6) Q:(XUSPM1="") 0
60 S XUSPM2=0 F I=0:0 S XUSPM2=$O(^VA(200,+Y,51,XUSPM2)) Q:XUSPM2'>0 D
61 .I $P($G(^DIC(19.1,XUSPM2,0)),"^")=XUSPM1 S XUSKFLG=0
62 Q XUSKFLG
Note: See TracBrowser for help on using the repository browser.