| 1 | XQ4 ;SF/GFT,SEA/JLI - Menu Diagram with entry/exit actions ;3/19/91 10:07 ;5/13/93 11:15 AM
|
|---|
| 2 | ;;8.0;KERNEL;;Jul 10, 1995
|
|---|
| 3 | S:'$D(XQ4) XQ4=0 W !! D INIT
|
|---|
| 4 | K DIC R "Select USER (U.xxxxx) or OPTION (O.xxxxx) name: ",X:DTIME G:'$T OUT I "O."=$E(X,1,2)!("o."=$E(X,1,2)) S X=$E(X,3,99),DIC=19,DIC(0)="QEMZ",FL="OP" G:X=""!(X["^") OUT D ^DIC G:Y'>0 XQ4 S D0=+Y G OPT
|
|---|
| 5 | I "U."=$E(X,1,2)!("u."=$E(X,1,2)) S X=$E(X,3,99),DIC=200,DIC(0)="QEMZ",DIC("S")="I $D(^(201)),^(201)",FL="US" G:X=""!(X["^") OUT D ^DIC G:Y'>0 XQ4 S D0=+Y,MQ=$P(Y(0),U,1),Y=+^VA(200,D0,201) I $D(^DIC(19,Y,0)) D E^XQ41 G:'FL QPU D GO G OUT
|
|---|
| 6 | S DIC=200,DIC(0)="QEMZ",DIC("S")="I $D(^(201)),^(201)",FL="US" G:X=""!(X["^") OUT
|
|---|
| 7 | RQUE S XQX=X D ^DIC I Y>0 R " OK (Y/N) ? ",XQI:DTIME I '$T!("Yy"[$E(XQI,1)) K XQX S D0=+Y,MQ=$P(Y(0),U,1),Y=+^VA(200,D0,201) I $D(^DIC(19,Y,0)) D E^XQ41 G:'FL QPU D GO G OUT
|
|---|
| 8 | S X=XQX,DIC=19,DIC(0)="QEMZ" W !,?5,X K XQX,DIC("S") D ^DIC S FL="OP",D0=+Y I Y'>0 G XQ4
|
|---|
| 9 | OPT I $P(Y(0),U,4)'="M" W !,*7,"This is not a menu option and therefore cannot be diagrammed.",! G XQ4
|
|---|
| 10 | D:Y>0 E^XQ41 G:'FL QPU G OUT
|
|---|
| 11 | ;
|
|---|
| 12 | OP ;Entry point for queued job to diagram menu for OPTION selection
|
|---|
| 13 | D INIT S Y=D0 D E^XQ41:$D(^DIC(19,Y,0)) D GO G OUT
|
|---|
| 14 | US ;Entry point for queued job to diagram menu for USER selection
|
|---|
| 15 | D INIT Q:'$D(^VA(200,D0,201)) S XQDUZ=D0,Y=+^(201) Q:'$D(^DIC(19,Y,0)) D E^XQ41,GO G OUT
|
|---|
| 16 | ;
|
|---|
| 17 | GO K X,XQV,DIC U IO S W=IOM\M-10,%="" S:W>33 W=33
|
|---|
| 18 | I W<10 D ^%ZISC W !,*7,"This menu contains too many levels to be diagrammed using this margin width." G XQ4
|
|---|
| 19 | W @IOF S X=^TMP($J,"XQM",1,0) W !,$P(X,U,3)," (",$P(X,U,2),")"
|
|---|
| 20 | I XQ4'<0 W:$P(X,U,4)]"" !,"**UNAVAILABLE**" W:$P(X,U,7)]"" !,"**LOCKED: ",$P(X,U,7),"**" W:XQ4>0&$D(^TMP($J,"XQM",1,0,.1)) !,"**ENTRY ACTION:",!,^(.1) W:XQ4>0&$D(^(.2)) !,"**EXIT ACTION:",!,^(.2)
|
|---|
| 21 | W !,"|",!,"|" K ^TMP($J,"XQM",1,0)
|
|---|
| 22 | S XQFLAG="" F XQL=1:1 Q:'$D(^TMP($J,"XQM",XQL)) Q:XQFLAG=U S XQT=M,L=1 K Z D ^XQ41
|
|---|
| 23 | I $D(IOST)#2,$E(IOST,1)="P" W #
|
|---|
| 24 | D OUT
|
|---|
| 25 | Q Q
|
|---|
| 26 | ;
|
|---|
| 27 | INIT K ^TMP($J,"XQM"),^TMP($J,"XQ1"),X,IOP,XQDUZ,XQDIC S L=0,XQL=1,X(0)=0,M=1
|
|---|
| 28 | Q
|
|---|
| 29 | QPU ;
|
|---|
| 30 | S %ZIS="QM" D ^%ZIS Q:POP
|
|---|
| 31 | I $D(IO("Q")) K IO("Q") S ZTRTN=FL_"^XQ4",ZTSAVE("D0")="",ZTSAVE("XQ4")="",ZTDESC="DIAGRAM MENUS" D ^%ZTLOAD K ZTSK G XQ4
|
|---|
| 32 | D:IO["" GO
|
|---|
| 33 | ;
|
|---|
| 34 | OUT K ^TMP($J,"XQM"),^TMP($J,"XQ1"),X,X1,X2,FL,IOP,XQDUZ,XQDIC,DIC
|
|---|
| 35 | D ^%ZISC
|
|---|
| 36 | K C,D,D0,L,M,MQ,POP,W,XQ4,XQB,XQBN,XQFLAG,XQI,XQJ,XQL,XQN,XQP,XQT,XQV,Y,Z
|
|---|
| 37 | I $D(ZTSK) K ^%ZTSK(ZTSK)
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | ABBREV ; Entry point for abbreviated (names only) display
|
|---|
| 41 | S XQ4=-1
|
|---|
| 42 | G XQ4
|
|---|
| 43 | ;
|
|---|
| 44 | NORMAL ; Entry point for regular (names, locks, etc.) display
|
|---|
| 45 | S XQ4=0
|
|---|
| 46 | G XQ4
|
|---|
| 47 | ;
|
|---|
| 48 | FULL ; Entry point for full listings (includes actions)
|
|---|
| 49 | S XQ4=1
|
|---|
| 50 | G XQ4
|
|---|
