source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTFCE1.m@ 862

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

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1XTFCE1 ;SF-ISC.SEA/JLI - DISPLAY FLOWCHARTS BY ENTRY POINT ;12/7/95 14:49
2 ;;7.3;TOOLKIT;**8**;Apr 25, 1995
3 W @IOF
4 S XTZX1="",XTSLINE=0,XTREF=0,XT="",XTZX1="" F Z=0:0 S Z=$O(^TMP($J,XTLEV,"FC",Z)) D:Z'>0 WAIT Q:+Z'=Z!(XT=U) I Z>0 S XTZX=$O(^TMP($J,XTLEV,"FC",Z,"")) D LIST Q:XT=U
5 Q
6 ;
7LIST ;
8 S N=60,X=^TMP($J,XTLEV,"FC",Z,XTZX) F XTZA=0:0 S Y=$E(X,1,4) Q:Y'=" "&(Y'="....") S X=$E(X,5,$L(X)),N=N-10 S:N<1 N=1
9 I $E(X,1)="{"!($E(X,1)="[") S XTL=$E(X,3,$L(X)-2) I '$D(^TMP($J,XTLEV,"C",$P(XTL,"("))) S XTREF=XTREF+1,^($P(XTL,"("),XTREF)="",^TMP($J,XTLEV,"X",XTREF)=$P(XTL,"(")
10 S:'$D(LN) LN=N D:LN<N CLOSE K NX F NX=N:10:60 S:'$D(NX(NX+10)) NX(NX)="" S:NX<60 NX(NX+20)=""
11 I XTZX1'="PROC "!(XTZX'="PROC ") W ! I LN'=N!(XTZX1'="GOTO "&(XTZX1'="QUIT ")) F NX=0:0 S NX=$O(NX(NX)) Q:NX="" W ?NX,"|"
12 S LN=N,N=$S(XTZX="LABEL":N-$L(X),1:N-($L(X)\2))
13 D:$Y+5+(XTREF+1\2)>IOSL WAIT Q:XT=U W !,?N,X S XTZX1=XTZX
14 F NX=0:0 S NX=$O(NX(NX)) Q:NX="" I $X<(NX-1) W ?NX,"|"
15 Q
16 ;
17WAIT ; Skip to top of next page
18 F K=1:1:4 Q:($Y+4+(XTREF+1\2))'<IOSL W !
19 I XTREF>0 W !,"The following references may be selected for expansion..."
20 I XTREF>0 F JK=1:1:(XTREF+1\2) W !?5,$J(JK,2),". ",^TMP($J,XTLEV,"X",JK) S JL=JK+(XTREF+1\2) I JL'>XTREF W ?30,$J(JL,2),". ",^(JL)
21 I XTREF>0 W !?16,"Select LINE^ROUTINE to expand (1 to ",XTREF," ) or"
22 I 1 S XT="" R:IOST["C-" !?16,"Press RETURN to continue, '^' to halt: ",XT:DTIME S:'$T XT=U
23 I XT>0&(XT'>XTREF) S XTSLINE(XTLEV)=XTSLINE,XTZX1(XTLEV)=XTZX1,XTLINE=^TMP($J,XTLEV,"X",+XT),XTROU=$P(XTLINE,U,2),XTLINE=$P(XTLINE,U,1),XTLEV=XTLEV+1
24 I XT>0&(XT'>XTREF) D NODE^XTFCE S XTLINE=XTLINE(XTLEV),XTROU=XTROU(XTLEV),Z=XTSLINE(XTLEV),XTZX1=XTZX1(XTLEV)
25 S XTZX1=XTZX1,XTSLINE=Z W @IOF
26 S XTREF=0 K ^TMP($J,XTLEV,"C"),^("X")
27 Q
28 ;
29CLOSE ; Close previous nesting level
30 S IX1=$S(LN>1:LN,1:0),IX2=IX1+19 S:XTZX1="GOTO "!(XTZX1="QUIT ") IX1=IX1+10 W ! W:IX1'>LN ?IX1,"|" W:IX1>LN ?IX1 F IX3=0:0 Q:($X'<(IX2+1)) W "_"
31 W "|" F NX=-1:0 S NX=$O(NX(NX)) Q:NX="" I $X<(NX-1) W ?NX,"|"
32 S LN=$S(LN>1:LN,1:0)+10 I LN<N S XTZX1=" " G CLOSE
33 S LN=LN-1
34 Q
Note: See TracBrowser for help on using the repository browser.