XQ31 ;SEA/AMF - MENU MANAGEMENT REPORTS ;09/30/94 10:07
;;8.0;KERNEL;;Jul 10, 1995
W !!,"This option lists options by parents, as well as running several other menu",!,"management utilities. It can be run for one option, one package or all."
PKG R !!,"Select PACKAGE/OPTION name: ALL// ",X:DTIME S:'$T X=U S DIC=9.4,DIC(0)="EMZ" Q:X[U S:'$L(X) X="ALL"
I X="ALL" S XQS="@z",XQE="zzz" G PRNT
D ^DIC I Y>0 S XQS=$P(Y(0),U,2),XQE=XQS_"zzz" G PRNT
S DIC=19,DIC(0)="QEMZ" D ^DIC G:Y<0 PKG S XQE=$P(Y(0),U,1),XQS=$E(XQE,1,$L(XQE)-1)_$C($A($E(XQE,$L(XQE)))-1)_"zzz"
;
PRNT ;
S %ZIS="MQ" D ^%ZIS G:POP OUT I $D(IO("Q")) K IO("Q") S ZTRTN="DQ1^XQ31",ZTDESC="DISPLAY PARENTS AND USES OF OPTIONS",ZTSAVE("XQS")="",ZTSAVE("XQE")="" D ^%ZTLOAD K ZTSK G OUT
;
DQ1 ; Entry point to list option parents and uses as a queued job
K XQHDR S XQHDR(1)="CROSS REFERENCE OF OPTIONS BY PARENTS",XQHDR(2)="OPTION PARENTS TASKED JOB, PRIMARY",XQHDR(3)=" OR SECONDARY MENU"
S XQENT=1,$P(XQDSH,"-",132)="-" K ^TMP($J) U IO
S XQP=1 D HDR,LP
OUT D ^%ZISC K XQUI,XQJ,XQS,XQE,XQK,XQLEN,XQNM,XQI,I,J,K,C,L,DIC,POP,X,XQDSH,XQENT,XQHDR,XQP,Y,ZISI,ZTDTH,ZTSAVE,ZTRTN,ZTDESC,%A1,S,XQFL
Q
LP S XQUI=0,XQJ=XQS F S XQJ=$O(^DIC(19,"B",XQJ)) Q:XQJ=""!XQUI!(XQJ]XQE) D LP1
Q
LP1 S XQI=0 F S XQI=$O(^DIC(19,"B",XQJ,XQI)) Q:XQI'>0!XQUI D LP2
Q
LP2 S XQFL="" D:$Y+3>IOSL&XQENT NWPG Q:XQUI W:XQENT !,XQJ,?31 I '$D(^DIC(19,"AD",XQI)) W:XQENT "** no parents **" G PRI
K XQFL S (XQK,XQLEN,XQNM)=0
I XQENT F S XQK=$O(^DIC(19,"AD",XQI,XQK)) Q:XQK'>0 I $D(^DIC(19,XQK,0)) S L=$P(^DIC(19,XQK,0),U,1) S:XQLEN+$L(L)+2>34 XQLEN=0 W:'XQLEN&XQNM !?31 W:XQNM&XQLEN ", " W $P(^DIC(19,XQK,0),U,1) S XQLEN=XQLEN+$L(L)+2,XQNM=XQNM+1
PRI ;
I $D(^VA(200,"AP",XQI)) W:XQENT ?65,"-P-" K XQFL
I $D(^VA(200,"AD",XQI)) W:XQENT ?70,"-S-" K XQFL
I $D(^DIC(19.2,"B",XQI)) D ;Check Schedule file
. N % S %=$O(^DIC(19.2,"B",XQI,0)) Q:%'>0
. S %=$G(^DIC(19.2,%,0)) I $P(%,U,2)!$L($P(%,U,7)) W:XQENT ?75,"-T-" K XQFL
I $D(XQFL) S ^TMP($J,XQI)=""
Q
NWPG I $E(IOST,1)="C" D CON S XQUI=(X="^") Q:XQUI
D HDR Q
CON W !!,"Press return to continue or '^' to escape " R X:DTIME S:'$T X=U
Q
HDR W @IOF,!,XQHDR(1),?70,"PAGE ",XQP S XQP=XQP+1
W:$D(XQHDR(2)) !!,XQHDR(2) W:$D(XQHDR(3)) !,XQHDR(3)
W !,$E(XQDSH,1,IOM-1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQ31 2410 printed Nov 22, 2024@17:14:53 Page 2
XQ31 ;SEA/AMF - MENU MANAGEMENT REPORTS ;09/30/94 10:07
+1 ;;8.0;KERNEL;;Jul 10, 1995
+2 WRITE !!,"This option lists options by parents, as well as running several other menu",!,"management utilities. It can be run for one option, one package or all."
PKG READ !!,"Select PACKAGE/OPTION name: ALL// ",X:DTIME
if '$TEST
SET X=U
SET DIC=9.4
SET DIC(0)="EMZ"
if X[U
QUIT
if '$LENGTH(X)
SET X="ALL"
+1 IF X="ALL"
SET XQS="@z"
SET XQE="zzz"
GOTO PRNT
+2 DO ^DIC
IF Y>0
SET XQS=$PIECE(Y(0),U,2)
SET XQE=XQS_"zzz"
GOTO PRNT
+3 SET DIC=19
SET DIC(0)="QEMZ"
DO ^DIC
if Y<0
GOTO PKG
SET XQE=$PIECE(Y(0),U,1)
SET XQS=$EXTRACT(XQE,1,$LENGTH(XQE)-1)_$CHAR($ASCII($EXTRACT(XQE,$LENGTH(XQE)))-1)_"zzz"
+4 ;
PRNT ;
+1 SET %ZIS="MQ"
DO ^%ZIS
if POP
GOTO OUT
IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="DQ1^XQ31"
SET ZTDESC="DISPLAY PARENTS AND USES OF OPTIONS"
SET ZTSAVE("XQS")=""
SET ZTSAVE("XQE")=""
DO ^%ZTLOAD
KILL ZTSK
GOTO OUT
+2 ;
DQ1 ; Entry point to list option parents and uses as a queued job
+1 KILL XQHDR
SET XQHDR(1)="CROSS REFERENCE OF OPTIONS BY PARENTS"
SET XQHDR(2)="OPTION PARENTS TASKED JOB, PRIMARY"
SET XQHDR(3)=" OR SECONDARY MENU"
+2 SET XQENT=1
SET $PIECE(XQDSH,"-",132)="-"
KILL ^TMP($JOB)
USE IO
+3 SET XQP=1
DO HDR
DO LP
OUT DO ^%ZISC
KILL XQUI,XQJ,XQS,XQE,XQK,XQLEN,XQNM,XQI,I,J,K,C,L,DIC,POP,X,XQDSH,XQENT,XQHDR,XQP,Y,ZISI,ZTDTH,ZTSAVE,ZTRTN,ZTDESC,%A1,S,XQFL
+1 QUIT
LP SET XQUI=0
SET XQJ=XQS
FOR
SET XQJ=$ORDER(^DIC(19,"B",XQJ))
if XQJ=""!XQUI!(XQJ]XQE)
QUIT
DO LP1
+1 QUIT
LP1 SET XQI=0
FOR
SET XQI=$ORDER(^DIC(19,"B",XQJ,XQI))
if XQI'>0!XQUI
QUIT
DO LP2
+1 QUIT
LP2 SET XQFL=""
if $Y+3>IOSL&XQENT
DO NWPG
if XQUI
QUIT
if XQENT
WRITE !,XQJ,?31
IF '$DATA(^DIC(19,"AD",XQI))
if XQENT
WRITE "** no parents **"
GOTO PRI
+1 KILL XQFL
SET (XQK,XQLEN,XQNM)=0
+2 IF XQENT
FOR
SET XQK=$ORDER(^DIC(19,"AD",XQI,XQK))
if XQK'>0
QUIT
IF $DATA(^DIC(19,XQK,0))
SET L=$PIECE(^DIC(19,XQK,0),U,1)
if XQLEN+$LENGTH(L)+2>34
SET XQLEN=0
if 'XQLEN&XQNM
WRITE !?31
if XQNM&XQLEN
WRITE ", "
WRITE $PIECE(^DIC(19,XQK,0),U,1)
SET XQLEN=XQLEN+$LENGTH(L)+2
SET XQNM=XQNM+1
PRI ;
+1 IF $DATA(^VA(200,"AP",XQI))
if XQENT
WRITE ?65,"-P-"
KILL XQFL
+2 IF $DATA(^VA(200,"AD",XQI))
if XQENT
WRITE ?70,"-S-"
KILL XQFL
+3 ;Check Schedule file
IF $DATA(^DIC(19.2,"B",XQI))
Begin DoDot:1
+4 NEW %
SET %=$ORDER(^DIC(19.2,"B",XQI,0))
if %'>0
QUIT
+5 SET %=$GET(^DIC(19.2,%,0))
IF $PIECE(%,U,2)!$LENGTH($PIECE(%,U,7))
if XQENT
WRITE ?75,"-T-"
KILL XQFL
End DoDot:1
+6 IF $DATA(XQFL)
SET ^TMP($JOB,XQI)=""
+7 QUIT
NWPG IF $EXTRACT(IOST,1)="C"
DO CON
SET XQUI=(X="^")
if XQUI
QUIT
+1 DO HDR
QUIT
CON WRITE !!,"Press return to continue or '^' to escape "
READ X:DTIME
if '$TEST
SET X=U
+1 QUIT
HDR WRITE @IOF,!,XQHDR(1),?70,"PAGE ",XQP
SET XQP=XQP+1
+1 if $DATA(XQHDR(2))
WRITE !!,XQHDR(2)
if $DATA(XQHDR(3))
WRITE !,XQHDR(3)
+2 WRITE !,$EXTRACT(XQDSH,1,IOM-1)
+3 QUIT
