source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQH3.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1XQH3 ;LL/THM,SEA/AMF,JLI -HELP FRAME XREF BY PARENT ;9/29/92 15:13 ;5/13/93 11:27 AM
2 ;;8.0;KERNEL;;Jul 10, 1995
3PKG 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"
4 I X="ALL" S XQS="@z",XQE="zzz" G SLIST
5 D ^DIC G:Y<0 PKG S XQS=$P(Y(0),U,2),XQE=XQS_"zzz"
6SLIST ;LIST PARENTS AND ORPHANS
7 S %ZIS="MQ" D ^%ZIS Q:POP I $D(IO("Q")) K IO("Q") G QUE
8DQ ; Entry point for queued job
9 U IO
10 K ^TMP($J) S XQI=0 D S0 S XQS=0 D S3
11 D:$D(^TMP($J)) S6
12KILL K XQI,XQK,XQJ,XQL,XQE,XQS,XQDSH,XQN,%DT,%H,%ZIS,%T,DIC,X,XQP,Y,^TMP($J)
13 D ^%ZISC
14 Q
15 ;
16S0 ;
17 S XQS=$O(^DIC(9.2,"B",XQS)) Q:XQS]XQE!(XQS="") D S1 G S0
18S1 ;
19 S XQI=$O(^DIC(9.2,"B",XQS,XQI)) Q:XQI="" S ^TMP($J,XQS,0)=XQI,XQJ=0 D S2 G S1
20S2 ;
21 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
22 S XQL=$P(^DIC(9.2,XQK,0),U,1)
23 I '$D(^TMP($J,XQL,"K")) S ^("K")=1,^TMP($J,XQL,1)=XQS G S2
24 S XQN=^TMP($J,XQL,"K")+1,^("K")=XQN,^TMP($J,XQL,XQN)=XQS G S2
25S3 ;
26 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
27S4 ;
28 S XQI=$O(^DIC(19,"AC",XQJ,XQI)) Q:XQI="" S XQK=$P(^DIC(19,XQI,0),U,1)
29 S $P(^TMP($J,XQS,XQL),U,2)=XQK,XQL=XQL+1 G S4
30S5 ;
31 S XQI=$O(^DIC(9.2,XQJ,3,XQI)) Q:XQI="" S XQK=^(XQI,0)
32 S $P(^TMP($J,XQS,XQL),U,3)=XQK,XQL=XQL+1 G S5
33S6 ;
34 S XQDSH="---------------------------------------------------------------------------------------------------------------------------"
35 S XQP=1 D HDR S (XQS,XQUI)=0 D SL
36 D ^%ZISC
37 K XQUI Q
38SL S XQS=$O(^TMP($J,XQS)) Q:XQS="" D:$Y+3>IOSL NWPG Q:XQUI W XQS
39 I '$D(^TMP($J,XQS,1)) W ?28,"** no parents **",!
40 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),!
41 G SL
42NWPG ;
43 I $E(IOST,1)="C" D CON S XQUI=(X="^") Q:XQUI
44 D HDR Q
45CON ;
46 W !,"Press return to continue or '^' to escape " R X:DTIME S:'$T X=U
47 Q
48HDR W @IOF,!,"CROSS REFERENCE OF HELP FRAMES BY PARENTS",?70,"PAGE ",XQP S XQP=XQP+1
49 W !!,"HELP",?28,"PARENTS",?56,"MENU",?71,"INVOKING"
50 W !,"FRAME",?56,"OPTIONS",?71,"ROUTINES"
51 W !,$E(XQDSH,1,IOM-1),!
52 Q
53 ;
54QUE ; Queue job to run later
55 S ZTRTN="DQ^XQH3",ZTSAVE("XQS")="",ZTSAVE("XQE")="",ZTDESC="HELP FRAME XREF BY PARENT" D ^%ZTLOAD K ZTSAVE,ZTSK,ZTRTN,ZTDESC
56 G KILL
Note: See TracBrowser for help on using the repository browser.