XQH3 ;LL/THM,SEA/AMF,JLI -HELP FRAME XREF BY PARENT ;9/29/92 15:13 ;5/13/93 11:27 AM [ 04/02/2003 8:29 AM ]
;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
;;8.0;KERNEL;;Jul 10, 1995
PKG R !!,"Select PACKAGE name: ALL// ",X:DTIME S:'$T X=U S DIC=9.4,DIC(0)="QEMZ" Q:X[U S:'$L(X) X="ALL"
I X="ALL" S XQS="@z",XQE="zzz" G SLIST
D ^DIC G:Y<0 PKG S XQS=$P(Y(0),U,2),XQE=XQS_"zzz"
SLIST ;LIST PARENTS AND ORPHANS
S %ZIS="MQ" D ^%ZIS Q:POP I $D(IO("Q")) K IO("Q") G QUE
DQ ; Entry point for queued job
U IO
K ^TMP($J) S XQI=0 D S0 S XQS=0 D S3
D:$D(^TMP($J)) S6
KILL K XQI,XQK,XQJ,XQL,XQE,XQS,XQDSH,XQN,%DT,%H,%ZIS,%T,DIC,X,XQP,Y,^TMP($J)
D ^%ZISC
Q
;
S0 ;
S XQS=$O(^DIC(9.2,"B",XQS)) Q:XQS]XQE!(XQS="") D S1 G S0
S1 ;
S XQI=$O(^DIC(9.2,"B",XQS,XQI)) Q:XQI="" S ^TMP($J,XQS,0)=XQI,XQJ=0 D S2 G S1
S2 ;
S XQJ=$O(^DIC(9.2,XQI,2,XQJ)) Q:+XQJ<1 S XQK=$P(^(XQJ,0),U,2) G:'$L(XQK) S2 I '$D(^DIC(9.2,XQK,0)) W !,*7,"HELP FRAME ",XQS," POINTS TO HELP FRAME ",XQK," WHICH DOES NOT EXIST " G S2
S XQL=$P(^DIC(9.2,XQK,0),U,1)
I '$D(^TMP($J,XQL,"K")) S ^("K")=1,^TMP($J,XQL,1)=XQS G S2
S XQN=^TMP($J,XQL,"K")+1,^("K")=XQN,^TMP($J,XQL,XQN)=XQS G S2
S3 ;
S XQI=0,XQL=1,XQS=$O(^TMP($J,XQS)) Q:XQS="" G:'$D(^(XQS,0)) S3 S XQJ=^(0) D:$D(^DIC(19,"AC",XQJ)) S4 S XQI=0,XQL=1 D:$D(^DIC(9.2,XQJ,3)) S5 G S3
S4 ;
S XQI=$O(^DIC(19,"AC",XQJ,XQI)) Q:XQI="" S XQK=$P(^DIC(19,XQI,0),U,1)
S $P(^TMP($J,XQS,XQL),U,2)=XQK,XQL=XQL+1 G S4
S5 ;
S XQI=$O(^DIC(9.2,XQJ,3,XQI)) Q:XQI="" S XQK=^(XQI,0)
S $P(^TMP($J,XQS,XQL),U,3)=XQK,XQL=XQL+1 G S5
S6 ;
S XQDSH="---------------------------------------------------------------------------------------------------------------------------"
S XQP=1 D HDR S (XQS,XQUI)=0 D SL
D ^%ZISC
K XQUI Q
SL S XQS=$O(^TMP($J,XQS)) Q:XQS="" D:$Y+3>IOSL NWPG Q:XQUI W XQS
I '$D(^TMP($J,XQS,1)) W ?28,"** no parents **",!
F XQJ=1:1 Q:'$D(^TMP($J,XQS,XQJ)) S XQK=^(XQJ) W ?28,$S('$L($P(XQK,U,1)):"** no parents **",1:$P(XQK,U,1)),?56,$P(XQK,U,2),?72,$P(XQK,U,3),!
G SL
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,!,"CROSS REFERENCE OF HELP FRAMES BY PARENTS",?70,"PAGE ",XQP S XQP=XQP+1
W !!,"HELP",?28,"PARENTS",?56,"MENU",?71,"INVOKING"
W !,"FRAME",?56,"OPTIONS",?71,"ROUTINES"
W !,$E(XQDSH,1,IOM-1),!
Q
;
QUE ; Queue job to run later
S ZTRTN="DQ^XQH3",ZTSAVE("XQS")="",ZTSAVE("XQE")="",ZTDESC="HELP FRAME XREF BY PARENT" D ^%ZTLOAD K ZTSAVE,ZTSK,ZTRTN,ZTDESC
G KILL
XQH3 ;LL/THM,SEA/AMF,JLI -HELP FRAME XREF BY PARENT ;9/29/92 15:13 ;5/13/93 11:27 AM [ 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
PKG READ !!,"Select PACKAGE name: ALL// ",X:DTIME
IF '$TEST
SET X=U
SET DIC=9.4
SET DIC(0)="QEMZ"
IF X[U
QUIT
IF '$LENGTH(X)
SET X="ALL"
+1 IF X="ALL"
SET XQS="@z"
SET XQE="zzz"
GOTO SLIST
+2 DO ^DIC
IF Y<0
GOTO PKG
SET XQS=$PIECE(Y(0),U,2)
SET XQE=XQS_"zzz"
SLIST ;LIST PARENTS AND ORPHANS
+1 SET %ZIS="MQ"
DO ^%ZIS
IF POP
QUIT
IF $DATA(IO("Q"))
KILL IO("Q")
GOTO QUE
DQ ; Entry point for queued job
+1 USE IO
+2 KILL ^TMP($JOB)
SET XQI=0
DO S0
SET XQS=0
DO S3
+3 IF $DATA(^TMP($JOB))
DO S6
KILL KILL XQI,XQK,XQJ,XQL,XQE,XQS,XQDSH,XQN,%DT,%H,%ZIS,%T,DIC,X,XQP,Y,^TMP($JOB)
+1 DO ^%ZISC
+2 QUIT
+3 ;
S0 ;
+1 SET XQS=$ORDER(^DIC(9.2,"B",XQS))
IF XQS]XQE!(XQS="")
QUIT
DO S1
GOTO S0
S1 ;
+1 SET XQI=$ORDER(^DIC(9.2,"B",XQS,XQI))
IF XQI=""
QUIT
SET ^TMP($JOB,XQS,0)=XQI
SET XQJ=0
DO S2
GOTO S1
S2 ;
+1 SET XQJ=$ORDER(^DIC(9.2,XQI,2,XQJ))
IF +XQJ<1
QUIT
SET XQK=$PIECE(^(XQJ,0),U,2)
IF '$LENGTH(XQK)
GOTO S2
IF '$DATA(^DIC(9.2,XQK,0))
WRITE !,*7,"HELP FRAME ",XQS," POINTS TO HELP FRAME ",XQK," WHICH DOES NOT EXIST "
GOTO S2
+2 SET XQL=$PIECE(^DIC(9.2,XQK,0),U,1)
+3 IF '$DATA(^TMP($JOB,XQL,"K"))
SET ^("K")=1
SET ^TMP($JOB,XQL,1)=XQS
GOTO S2
+4 SET XQN=^TMP($JOB,XQL,"K")+1
SET ^("K")=XQN
SET ^TMP($JOB,XQL,XQN)=XQS
GOTO S2
S3 ;
+1 SET XQI=0
SET XQL=1
SET XQS=$ORDER(^TMP($JOB,XQS))
IF XQS=""
QUIT
IF '$DATA(^(XQS,0))
GOTO S3
SET XQJ=^(0)
IF $DATA(^DIC(19,"AC",XQJ))
DO S4
SET XQI=0
SET XQL=1
IF $DATA(^DIC(9.2,XQJ,3))
DO S5
GOTO S3
S4 ;
+1 SET XQI=$ORDER(^DIC(19,"AC",XQJ,XQI))
IF XQI=""
QUIT
SET XQK=$PIECE(^DIC(19,XQI,0),U,1)
+2 SET $PIECE(^TMP($JOB,XQS,XQL),U,2)=XQK
SET XQL=XQL+1
GOTO S4
S5 ;
+1 SET XQI=$ORDER(^DIC(9.2,XQJ,3,XQI))
IF XQI=""
QUIT
SET XQK=^(XQI,0)
+2 SET $PIECE(^TMP($JOB,XQS,XQL),U,3)=XQK
SET XQL=XQL+1
GOTO S5
S6 ;
+1 SET XQDSH="---------------------------------------------------------------------------------------------------------------------------"
+2 SET XQP=1
DO HDR
SET (XQS,XQUI)=0
DO SL
+3 DO ^%ZISC
+4 KILL XQUI
QUIT
SL SET XQS=$ORDER(^TMP($JOB,XQS))
IF XQS=""
QUIT
IF $Y+3>IOSL
DO NWPG
IF XQUI
QUIT
WRITE XQS
+1 IF '$DATA(^TMP($JOB,XQS,1))
WRITE ?28,"** no parents **",!
+2 FOR XQJ=1:1
IF '$DATA(^TMP($JOB,XQS,XQJ))
QUIT
SET XQK=^(XQJ)
WRITE ?28,$SELECT('$LENGTH($PIECE(XQK,U,1)):"** no parents **",1:$PIECE(XQK,U,1)),?56,$PIECE(XQK,U,2),?72,$PIECE(XQK,U,3),!
+3 GOTO SL
NWPG ;
+1 IF $EXTRACT(IOST,1)="C"
DO CON
SET XQUI=(X="^")
IF XQUI
QUIT
+2 DO HDR
QUIT
CON ;
+1 WRITE !,"Press return to continue or '^' to escape "
READ X:DTIME
IF '$TEST
SET X=U
+2 QUIT
HDR WRITE @IOF,!,"CROSS REFERENCE OF HELP FRAMES BY PARENTS",?70,"PAGE ",XQP
SET XQP=XQP+1
+1 WRITE !!,"HELP",?28,"PARENTS",?56,"MENU",?71,"INVOKING"
+2 WRITE !,"FRAME",?56,"OPTIONS",?71,"ROUTINES"
+3 WRITE !,$EXTRACT(XQDSH,1,IOM-1),!
+4 QUIT
+5 ;
QUE ; Queue job to run later
+1 SET ZTRTN="DQ^XQH3"
SET ZTSAVE("XQS")=""
SET ZTSAVE("XQE")=""
SET ZTDESC="HELP FRAME XREF BY PARENT"
DO ^%ZTLOAD
KILL ZTSAVE,ZTSK,ZTRTN,ZTDESC
+2 GOTO KILL
