| 1 | IMRKEYS ;ISC-SF/JLI,HCIOFO/FT-DISPLAY HOLDERS OF 'IMR' KEYS ;10/17/97 10:09
|
|---|
| 2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
|
|---|
| 3 | ;[IMR KEYS] - Show users with access to 'ICR' keys
|
|---|
| 4 | I '$D(^XUSEC("IMRMGR",DUZ)) S IMRLOC="IMRKEYS" D ACESSERR^IMRERR,H^XUS K IMRLOC
|
|---|
| 5 | W:$Y>0 @IOF
|
|---|
| 6 | W !,"Holders of KEYS for 'IMR' Package as of: ",$$FMTE^XLFDT($$NOW^XLFDT(),1)
|
|---|
| 7 | S A="IMR",J=0,IMRUT=0
|
|---|
| 8 | F I=0:0 S I=$O(^XUSEC(A,I)) Q:I'>0!(IMRUT) D
|
|---|
| 9 | .W:J=0 !!,A," KEY HOLDERS:"
|
|---|
| 10 | .S J=1
|
|---|
| 11 | .I $Y>(IOSL-4) D PRTC Q:IMRUT W @IOF
|
|---|
| 12 | .W !?20,$S($D(^VA(200,I,0)):$P(^(0),U),1:"UNKNOWN USER # "_I)
|
|---|
| 13 | .Q
|
|---|
| 14 | 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
|
|---|
| 15 | .W:J=0 !!,A," KEY HOLDERS:"
|
|---|
| 16 | .S J=1
|
|---|
| 17 | .I $Y>(IOSL-4) D PRTC Q:IMRUT W @IOF
|
|---|
| 18 | .W !?20,$S($D(^VA(200,K,0)):$P(^(0),U),1:"UNKNOWN USER # "_K)
|
|---|
| 19 | .Q
|
|---|
| 20 | I 'IMRUT D PRTC
|
|---|
| 21 | K A,I,IMRUT,J,K,D,DISYS,X,Y
|
|---|
| 22 | Q
|
|---|
| 23 | PRTC ; press return to continue
|
|---|
| 24 | Q:$E(IOST)'="C" ;quit if terminal
|
|---|
| 25 | Q:$D(IO("S")) ;quit if slave device
|
|---|
| 26 | K DIR S DIR(0)="E" D ^DIR K DIR S:$D(DIRUT) IMRUT=1
|
|---|
| 27 | Q
|
|---|
