- XQ31 ;SEA/AMF - MENU MANAGEMENT REPORTS ;09/30/94 10:07 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- ;;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
- XQ31 ;SEA/AMF - MENU MANAGEMENT REPORTS ;09/30/94 10:07 [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- +2 ;;8.0;KERNEL;;Jul 10, 1995
- +3 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
