| 1 | XQ55 ; SEA/AMF,MJM,JLI - SEARCH FOR USERS ACCESS TO AN OPTION [4/12/04 4:36am]
|
|---|
| 2 | ;;8.0;KERNEL;**140,342**;Jul 10, 1995
|
|---|
| 3 | INIT ;
|
|---|
| 4 | S XQDSH="-------------------------------------------------------------------------------"
|
|---|
| 5 | D ^XQDATE S XQDT=%Y
|
|---|
| 6 | OPT W ! S DIC=19,DIC(0)="AEQM" D ^DIC G:Y=-1 OUT S XQOPT=+Y
|
|---|
| 7 | MPAT W !!,"Show menu paths" S %=2 D YN^DICN G:%<0 OUT S XQMP=2-% I '% W !!,"If you answer 'YES', the listing will include the menu path(s) each user has",!,"to access the specified option." G MPAT
|
|---|
| 8 | K ^TMP($J),XQR,XQP
|
|---|
| 9 | S K=^DIC(19,XQOPT,0),XQHDR="Access to '"_$P(K,U,2)_"' ["_$P(K,U,1)_"]",XQSCD=0
|
|---|
| 10 | LOOP1 S K=XQOPT,(L,X(0))=0,XQD=K K XQR,XQA,XQK,XQRV S XQR(K)="" I '$L($P(^DIC(19,K,0),U,3)) D TREE1
|
|---|
| 11 | G LOOP2
|
|---|
| 12 | Q
|
|---|
| 13 | TREE S X(L)=$O(^DIC(19,"AD",XQD,X(L))) Q:X(L)'>0 S K=X(L) G:$D(XQR(K)) TREE S XQR(K)=""
|
|---|
| 14 | TREE1 ;
|
|---|
| 15 | S Y(0)=^DIC(19,K,0) G:$L($P(Y(0),U,3)) TREE S:$L($P(Y(0),U,6)) XQK(L)=$P(Y(0),U,6) S XQA(L)=K I $P(Y(0),U,16) S XQRV(L)=^DIC(19,K,3)
|
|---|
| 16 | D SETGLO S L=L+1,X(L)=0,(XQD,XQD(L))=K D TREE
|
|---|
| 17 | Q:L=1 K XQR(XQD(L)) S L=L-1 K XQA(L),XQK(L),XQRV(L) S XQD=XQD(L) G TREE
|
|---|
| 18 | Q
|
|---|
| 19 | SETGLO ;
|
|---|
| 20 | S XQK="" F I=L:-1:0 I $D(XQK(I)),$L(XQK(I)) S XQK=XQK_XQK(I)_","
|
|---|
| 21 | S XQRV="" F I=L:-1:0 I $D(XQRV(I)),$L(XQRV(I)) S XQRV=XQRV_XQRV(I)_","
|
|---|
| 22 | S XQA="" F I=L:-1:1 I $D(XQA(I)) S XQA=XQA_XQA(I)_","
|
|---|
| 23 | S XQA=XQA_XQOPT,J=0 S:$D(^TMP($J,K,0)) J=^(0) S J=J+1,^(0)=J,^TMP($J,K,J)=XQK_U_XQA_U_XQRV
|
|---|
| 24 | Q
|
|---|
| 25 | LOOP2 ;
|
|---|
| 26 | S XQPA(0)=0,XQP=0 F S XQP=$O(^TMP($J,XQP)) Q:XQP="" S XQN=^TMP($J,XQP,0) S XQPS="AP" D USERS S XQPS="AD" D USERS
|
|---|
| 27 | G LOOP3
|
|---|
| 28 | USERS ;
|
|---|
| 29 | S XQU=0 F S XQU=$O(^VA(200,XQPS,XQP,XQU)) Q:XQU'>0 I $D(^VA(200,XQU,.1)),+$$ACTIVE^XUSER(XQU) D EACHU
|
|---|
| 30 | Q
|
|---|
| 31 | EACHU ;
|
|---|
| 32 | S II=1
|
|---|
| 33 | F J=1:1:XQN Q:'$D(^TMP($J,XQP,J)) D
|
|---|
| 34 | .S XQK=$P(^TMP($J,XQP,J),U,1),XX=$L(XQK,",")-1,XQGO=1
|
|---|
| 35 | .I XX F X=1:1:XX S Y=$P(XQK,",",X) I Y'="",('$D(^XUSEC(Y,XQU))) S XQGO=0
|
|---|
| 36 | .S XQK=$P(^TMP($J,XQP,J),U,3),XX=$L(XQK,",")-1
|
|---|
| 37 | .I XX F X=1:1:XX S Y=$P(XQK,",",X) I Y'="",($D(^XUSEC(Y,XQU))) S XQGO=0
|
|---|
| 38 | .D:XQGO SETU
|
|---|
| 39 | Q
|
|---|
| 40 | SETU ;
|
|---|
| 41 | S XQPA=$P(^TMP($J,XQP,J),U,2)
|
|---|
| 42 | I '$D(XQPA(XQPA)) S I=XQPA(0)+1,XQPA(0)=I,XQPA(0,I)=XQPA,XQPA(XQPA)=I
|
|---|
| 43 | S XQPA=XQPA(XQPA) S:XQPS="AD" XQPA=XQPA_"(S)",XQSCD=1
|
|---|
| 44 | S I=$P(^VA(200,XQU,0),U,1)_U_XQU S:$D(^TMP($J,0,I)) II=$O(^TMP($J,0,I,"A"),-1)+1 S ^TMP($J,0,I,II)=XQPA
|
|---|
| 45 | Q
|
|---|
| 46 | LOOP3 ;
|
|---|
| 47 | I $O(^TMP($J,0,0))="" W !!,"** NO USERS CAN ACCESS THIS OPTION **" G OUT
|
|---|
| 48 | S %ZIS="MFQ" D ^%ZIS G OUT:POP I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^XQ55",ZTDESC="OPTION ACCESS BY USER",ZTSAVE("XQ*")="",ZTSAVE("^TMP($J,")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTSAVE,ZTDESC G OUT
|
|---|
| 49 | ;
|
|---|
| 50 | DQ ;Entry point for queued job
|
|---|
| 51 | U IO
|
|---|
| 52 | S:'XQMP XQPA(0)=-4 S XQPG=0,XQUI=0 D NEWPG G:XQUI MUS
|
|---|
| 53 | S XQU=0 F S XQU=$O(^TMP($J,0,XQU)) Q:XQU="" D PRTU G:XQUI MUS
|
|---|
| 54 | D:XQMP MENUPAT G MUS
|
|---|
| 55 | NEWPG ;
|
|---|
| 56 | S X="" I XQPG,$E(IOST,1)="C" D CON S XQUI=(X="^") Q:XQUI
|
|---|
| 57 | D HDR Q
|
|---|
| 58 | CON ;
|
|---|
| 59 | W !!,"Press return to continue or '^' to escape " R X:DTIME S:'$T X=U
|
|---|
| 60 | Q
|
|---|
| 61 | HDR ;
|
|---|
| 62 | W @IOF S XQPG=XQPG+1
|
|---|
| 63 | W "Page ",XQPG,?62,XQDT,!! S XQTAB=(76-$L(XQHDR))/2 W ?XQTAB,XQHDR
|
|---|
| 64 | W !!,"USER NAME",?27,"LAST ON",?37,"PRIMARY MENU" W:XQMP ?63,"PATH(S)"
|
|---|
| 65 | W !,$E(XQDSH,1,25),?27,$E(XQDSH,1,8),?37,$E(XQDSH,1,$S(XQMP:24,1:40)) W:XQMP ?63,$E(XQDSH,1,14)
|
|---|
| 66 | Q
|
|---|
| 67 | PRTU ;
|
|---|
| 68 | I $Y>(IOSL-XQPA(0)-8) D:XQMP MENUPAT D NEWPG Q:XQUI
|
|---|
| 69 | S J=$P(XQU,U,2),K="" S:$D(^VA(200,J,1.1)) K=$P(^(1.1),"^") S:$L(K) K=$E(K,4,5)_"/"_$E(K,6,7)_"/"_$E(K,2,3) W !,$E($P(XQU,U,1),1,27),?27,K
|
|---|
| 70 | I $D(^VA(200,J,201)) S K=+^(201) I K>0,$D(^DIC(19,K,0)) W ?37,$E($P(^(0),U,1),1,24)
|
|---|
| 71 | I XQMP D
|
|---|
| 72 | .W ?63,""
|
|---|
| 73 | .S JJ=$O(^TMP($J,0,XQU,"A"),-1)
|
|---|
| 74 | .F II=1:1:JJ W $G(^TMP($J,0,XQU,II)) I II'=JJ W ","
|
|---|
| 75 | I 'XQMP D
|
|---|
| 76 | .S II=0 F S II=$O(^TMP($J,0,XQU,II)) Q:II'>0 D
|
|---|
| 77 | ..I ^TMP($J,0,XQU,II)["(S)" W " (Secondary menu)" S II="A"
|
|---|
| 78 | Q
|
|---|
| 79 | MENUPAT ;
|
|---|
| 80 | W !!,$E(XQDSH,1,27)," MENU PATH(S) ",$E(XQDSH,1,29),!
|
|---|
| 81 | F I=1:1:XQPA(0) S K=XQPA(0,I) W !,I,".",?4 F N=1:1 Q:'$L($P(K,",",N)) W:N>1 " ... " W $P(^DIC(19,$P(K,",",N),0),U,1)
|
|---|
| 82 | I XQSCD W !,"(S) - secondary menu pathway"
|
|---|
| 83 | Q
|
|---|
| 84 | MUS G:X="^" OUT I XQPG,$E(IOST,1)="C" W !!,"Press return when finished viewing " R X:DTIME W @IOF G OUT
|
|---|
| 85 | I $D(ZTSK) K ^%ZTSK(ZTSK)
|
|---|
| 86 | OUT ;
|
|---|
| 87 | D ^%ZISC
|
|---|
| 88 | KILL K XQDT,XQGO,XQN,XQP,XQR,XQRV,XQOPT,XQPA,XQUI,XQSCD,XQDSH,XQU,N,K,J,X,XQA,XQD,XQHDR,XQK,XQP,XQPS,XQMP,XQPG,XX
|
|---|
| 89 | K DIC,I,II,JJ,L,POP,Y I $D(ZTQUEUED),$D(ZTSK),ZTSK>0 K ^%ZTSK(ZTSK)
|
|---|
| 90 | Q
|
|---|
