28 lines
1.0 KiB
Mathematica
28 lines
1.0 KiB
Mathematica
IMRKEYS ;ISC-SF/JLI,HCIOFO/FT-DISPLAY HOLDERS OF 'IMR' KEYS ;10/17/97 10:09
|
|
;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
|
|
;[IMR KEYS] - Show users with access to 'ICR' keys
|
|
I '$D(^XUSEC("IMRMGR",DUZ)) S IMRLOC="IMRKEYS" D ACESSERR^IMRERR,H^XUS K IMRLOC
|
|
W:$Y>0 @IOF
|
|
W !,"Holders of KEYS for 'IMR' Package as of: ",$$FMTE^XLFDT($$NOW^XLFDT(),1)
|
|
S A="IMR",J=0,IMRUT=0
|
|
F I=0:0 S I=$O(^XUSEC(A,I)) Q:I'>0!(IMRUT) D
|
|
.W:J=0 !!,A," KEY HOLDERS:"
|
|
.S J=1
|
|
.I $Y>(IOSL-4) D PRTC Q:IMRUT W @IOF
|
|
.W !?20,$S($D(^VA(200,I,0)):$P(^(0),U),1:"UNKNOWN USER # "_I)
|
|
.Q
|
|
F I=0:0 S J=0,A=$O(^XUSEC(A)) Q:A=""!($E(A,1,3)'="IMR")!(IMRUT) F K=0:0 S K=$O(^XUSEC(A,K)) Q:K'>0!(IMRUT) D
|
|
.W:J=0 !!,A," KEY HOLDERS:"
|
|
.S J=1
|
|
.I $Y>(IOSL-4) D PRTC Q:IMRUT W @IOF
|
|
.W !?20,$S($D(^VA(200,K,0)):$P(^(0),U),1:"UNKNOWN USER # "_K)
|
|
.Q
|
|
I 'IMRUT D PRTC
|
|
K A,I,IMRUT,J,K,D,DISYS,X,Y
|
|
Q
|
|
PRTC ; press return to continue
|
|
Q:$E(IOST)'="C" ;quit if terminal
|
|
Q:$D(IO("S")) ;quit if slave device
|
|
K DIR S DIR(0)="E" D ^DIR K DIR S:$D(DIRUT) IMRUT=1
|
|
Q
|