source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRKEYS.m@ 1556

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

initial load of WorldVistAEHR

File size: 1.0 KB
Line 
1IMRKEYS ;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
23PRTC ; 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
Note: See TracBrowser for help on using the repository browser.