XQ4 ;SF/GFT,SEA/JLI - Menu Diagram with entry/exit actions ;3/19/91 10:07 ;5/13/93 11:15 AM
;;8.0;KERNEL;;Jul 10, 1995
S:'$D(XQ4) XQ4=0 W !! D INIT
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
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
S DIC=200,DIC(0)="QEMZ",DIC("S")="I $D(^(201)),^(201)",FL="US" G:X=""!(X["^") OUT
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
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
OPT I $P(Y(0),U,4)'="M" W !,*7,"This is not a menu option and therefore cannot be diagrammed.",! G XQ4
D:Y>0 E^XQ41 G:'FL QPU G OUT
;
OP ;Entry point for queued job to diagram menu for OPTION selection
D INIT S Y=D0 D E^XQ41:$D(^DIC(19,Y,0)) D GO G OUT
US ;Entry point for queued job to diagram menu for USER selection
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
;
GO K X,XQV,DIC U IO S W=IOM\M-10,%="" S:W>33 W=33
I W<10 D ^%ZISC W !,*7,"This menu contains too many levels to be diagrammed using this margin width." G XQ4
W @IOF S X=^TMP($J,"XQM",1,0) W !,$P(X,U,3)," (",$P(X,U,2),")"
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)
W !,"|",!,"|" K ^TMP($J,"XQM",1,0)
S XQFLAG="" F XQL=1:1 Q:'$D(^TMP($J,"XQM",XQL)) Q:XQFLAG=U S XQT=M,L=1 K Z D ^XQ41
I $D(IOST)#2,$E(IOST,1)="P" W #
D OUT
Q Q
;
INIT K ^TMP($J,"XQM"),^TMP($J,"XQ1"),X,IOP,XQDUZ,XQDIC S L=0,XQL=1,X(0)=0,M=1
Q
QPU ;
S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) K IO("Q") S ZTRTN=FL_"^XQ4",ZTSAVE("D0")="",ZTSAVE("XQ4")="",ZTDESC="DIAGRAM MENUS" D ^%ZTLOAD K ZTSK G XQ4
D:IO["" GO
;
OUT K ^TMP($J,"XQM"),^TMP($J,"XQ1"),X,X1,X2,FL,IOP,XQDUZ,XQDIC,DIC
D ^%ZISC
K C,D,D0,L,M,MQ,POP,W,XQ4,XQB,XQBN,XQFLAG,XQI,XQJ,XQL,XQN,XQP,XQT,XQV,Y,Z
I $D(ZTSK) K ^%ZTSK(ZTSK)
Q
;
ABBREV ; Entry point for abbreviated (names only) display
S XQ4=-1
G XQ4
;
NORMAL ; Entry point for regular (names, locks, etc.) display
S XQ4=0
G XQ4
;
FULL ; Entry point for full listings (includes actions)
S XQ4=1
G XQ4
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQ4 2673 printed Apr 09, 2024@21:14:26 Page 2
XQ4 ;SF/GFT,SEA/JLI - Menu Diagram with entry/exit actions ;3/19/91 10:07 ;5/13/93 11:15 AM
+1 ;;8.0;KERNEL;;Jul 10, 1995
+2 if '$DATA(XQ4)
SET XQ4=0
WRITE !!
DO INIT
+3 KILL DIC
READ "Select USER (U.xxxxx) or OPTION (O.xxxxx) name: ",X:DTIME
if '$TEST
GOTO OUT
IF "O."=$EXTRACT(X,1,2)!("o."=$EXTRACT(X,1,2))
SET X=$EXTRACT(X,3,99)
SET DIC=19
SET DIC(0)="QEMZ"
SET FL="OP"
if X=""!(X["^")
GOTO OUT
DO ^DIC
if Y'>0
GOTO XQ4
SET D0=+Y
GOTO OPT
+4 IF "U."=$EXTRACT(X,1,2)!("u."=$EXTRACT(X,1,2))
SET X=$EXTRACT(X,3,99)
SET DIC=200
SET DIC(0)="QEMZ"
SET DIC("S")="I $D(^(201)),^(201)"
SET FL="US"
if X=""!(X["^")
GOTO OUT
DO ^DIC
if Y'>0
GOTO XQ4
SET D0=+Y
SET MQ=$PIECE(Y(0),U,1)
SET Y=+^VA(200,D0,201)
IF $DATA(^DIC(19,Y,0))
DO E^XQ41
if 'FL
GOTO QPU
DO GO
GOTO OUT
+5 SET DIC=200
SET DIC(0)="QEMZ"
SET DIC("S")="I $D(^(201)),^(201)"
SET FL="US"
if X=""!(X["^")
GOTO OUT
RQUE SET XQX=X
DO ^DIC
IF Y>0
READ " OK (Y/N) ? ",XQI:DTIME
IF '$TEST!("Yy"[$EXTRACT(XQI,1))
KILL XQX
SET D0=+Y
SET MQ=$PIECE(Y(0),U,1)
SET Y=+^VA(200,D0,201)
IF $DATA(^DIC(19,Y,0))
DO E^XQ41
if 'FL
GOTO QPU
DO GO
GOTO OUT
+1 SET X=XQX
SET DIC=19
SET DIC(0)="QEMZ"
WRITE !,?5,X
KILL XQX,DIC("S")
DO ^DIC
SET FL="OP"
SET D0=+Y
IF Y'>0
GOTO XQ4
OPT IF $PIECE(Y(0),U,4)'="M"
WRITE !,*7,"This is not a menu option and therefore cannot be diagrammed.",!
GOTO XQ4
+1 if Y>0
DO E^XQ41
if 'FL
GOTO QPU
GOTO OUT
+2 ;
OP ;Entry point for queued job to diagram menu for OPTION selection
+1 DO INIT
SET Y=D0
if $DATA(^DIC(19,Y,0))
DO E^XQ41
DO GO
GOTO OUT
US ;Entry point for queued job to diagram menu for USER selection
+1 DO INIT
if '$DATA(^VA(200,D0,201))
QUIT
SET XQDUZ=D0
SET Y=+^(201)
if '$DATA(^DIC(19,Y,0))
QUIT
DO E^XQ41
DO GO
GOTO OUT
+2 ;
GO KILL X,XQV,DIC
USE IO
SET W=IOM\M-10
SET %=""
if W>33
SET W=33
+1 IF W<10
DO ^%ZISC
WRITE !,*7,"This menu contains too many levels to be diagrammed using this margin width."
GOTO XQ4
+2 WRITE @IOF
SET X=^TMP($JOB,"XQM",1,0)
WRITE !,$PIECE(X,U,3)," (",$PIECE(X,U,2),")"
+3 IF XQ4'<0
if $PIECE(X,U,4)]""
WRITE !,"**UNAVAILABLE**"
if $PIECE(X,U,7)]""
WRITE !,"**LOCKED: ",$PIECE(X,U,7),"**"
if XQ4>0&$DATA(^TMP($JOB,"XQM",1,0,.1))
WRITE !,"**ENTRY ACTION:",!,^(.1)
if XQ4>0&$DATA(^(.2))
WRITE !,"**EXIT ACTION:",!,^(.2)
+4 WRITE !,"|",!,"|"
KILL ^TMP($JOB,"XQM",1,0)
+5 SET XQFLAG=""
FOR XQL=1:1
if '$DATA(^TMP($JOB,"XQM",XQL))
QUIT
if XQFLAG=U
QUIT
SET XQT=M
SET L=1
KILL Z
DO ^XQ41
+6 IF $DATA(IOST)#2
IF $EXTRACT(IOST,1)="P"
WRITE #
+7 DO OUT
Q QUIT
+1 ;
INIT KILL ^TMP($JOB,"XQM"),^TMP($JOB,"XQ1"),X,IOP,XQDUZ,XQDIC
SET L=0
SET XQL=1
SET X(0)=0
SET M=1
+1 QUIT
QPU ;
+1 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+2 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN=FL_"^XQ4"
SET ZTSAVE("D0")=""
SET ZTSAVE("XQ4")=""
SET ZTDESC="DIAGRAM MENUS"
DO ^%ZTLOAD
KILL ZTSK
GOTO XQ4
+3 if IO[""
DO GO
+4 ;
OUT KILL ^TMP($JOB,"XQM"),^TMP($JOB,"XQ1"),X,X1,X2,FL,IOP,XQDUZ,XQDIC,DIC
+1 DO ^%ZISC
+2 KILL C,D,D0,L,M,MQ,POP,W,XQ4,XQB,XQBN,XQFLAG,XQI,XQJ,XQL,XQN,XQP,XQT,XQV,Y,Z
+3 IF $DATA(ZTSK)
KILL ^%ZTSK(ZTSK)
+4 QUIT
+5 ;
ABBREV ; Entry point for abbreviated (names only) display
+1 SET XQ4=-1
+2 GOTO XQ4
+3 ;
NORMAL ; Entry point for regular (names, locks, etc.) display
+1 SET XQ4=0
+2 GOTO XQ4
+3 ;
FULL ; Entry point for full listings (includes actions)
+1 SET XQ4=1
+2 GOTO XQ4
