VistA-WorldVistAEHR/r/ICR_IMMUNOLOGY_CASE_REGISTR.../IMRKEYS.m

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