- XQH3 ;LL/THM,SEA/AMF,JLI -HELP FRAME XREF BY PARENT ;9/29/92 15:13 ;5/13/93 11:27 AM
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQH3 2498 printed Feb 18, 2025@23:32:09 Page 2
- XQH3 ;LL/THM,SEA/AMF,JLI -HELP FRAME XREF BY PARENT ;9/29/92 15:13 ;5/13/93 11:27 AM
- +1 ;;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