- 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 Feb 18, 2025@23:31:13 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