XTFCE1 ;SF-ISC.SEA/JLI - DISPLAY FLOWCHARTS BY ENTRY POINT ;12/7/95 14:49 [ 04/02/2003 8:47 AM ]
;;7.3;TOOLKIT;**1001**;APR 1, 2003
;;7.3;TOOLKIT;**8**;Apr 25, 1995
W @IOF
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
Q
;
LIST ;
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
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,"(")
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)=""
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,"|"
S LN=N,N=$S(XTZX="LABEL":N-$L(X),1:N-($L(X)\2))
D:$Y+5+(XTREF+1\2)>IOSL WAIT Q:XT=U W !,?N,X S XTZX1=XTZX
F NX=0:0 S NX=$O(NX(NX)) Q:NX="" I $X<(NX-1) W ?NX,"|"
Q
;
WAIT ; Skip to top of next page
F K=1:1:4 Q:($Y+4+(XTREF+1\2))'<IOSL W !
I XTREF>0 W !,"The following references may be selected for expansion..."
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)
I XTREF>0 W !?16,"Select LINE^ROUTINE to expand (1 to ",XTREF," ) or"
I 1 S XT="" R:IOST["C-" !?16,"Press RETURN to continue, '^' to halt: ",XT:DTIME S:'$T XT=U
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
I XT>0&(XT'>XTREF) D NODE^XTFCE S XTLINE=XTLINE(XTLEV),XTROU=XTROU(XTLEV),Z=XTSLINE(XTLEV),XTZX1=XTZX1(XTLEV)
S XTZX1=XTZX1,XTSLINE=Z W @IOF
S XTREF=0 K ^TMP($J,XTLEV,"C"),^("X")
Q
;
CLOSE ; Close previous nesting level
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 "_"
W "|" F NX=-1:0 S NX=$O(NX(NX)) Q:NX="" I $X<(NX-1) W ?NX,"|"
S LN=$S(LN>1:LN,1:0)+10 I LN<N S XTZX1=" " G CLOSE
S LN=LN-1
Q
XTFCE1 ;SF-ISC.SEA/JLI - DISPLAY FLOWCHARTS BY ENTRY POINT ;12/7/95 14:49 [ 04/02/2003 8:47 AM ]
+1 ;;7.3;TOOLKIT;**1001**;APR 1, 2003
+2 ;;7.3;TOOLKIT;**8**;Apr 25, 1995
+3 WRITE @IOF
+4 SET XTZX1=""
SET XTSLINE=0
SET XTREF=0
SET XT=""
SET XTZX1=""
FOR Z=0:0
SET Z=$ORDER(^TMP($JOB,XTLEV,"FC",Z))
IF Z'>0
DO WAIT
IF +Z'=Z!(XT=U)
QUIT
IF Z>0
SET XTZX=$ORDER(^TMP($JOB,XTLEV,"FC",Z,""))
DO LIST
IF XT=U
QUIT
+5 QUIT
+6 ;
LIST ;
+1 SET N=60
SET X=^TMP($JOB,XTLEV,"FC",Z,XTZX)
FOR XTZA=0:0
SET Y=$EXTRACT(X,1,4)
IF Y'=" "&(Y'="....")
QUIT
SET X=$EXTRACT(X,5,$LENGTH(X))
SET N=N-10
IF N<1
SET N=1
+2 IF $EXTRACT(X,1)="{"!($EXTRACT(X,1)="[")
SET XTL=$EXTRACT(X,3,$LENGTH(X)-2)
IF '$DATA(^TMP($JOB,XTLEV,"C",$PIECE(XTL,"(")))
SET XTREF=XTREF+1
SET ^($PIECE(XTL,"("),XTREF)=""
SET ^TMP($JOB,XTLEV,"X",XTREF)=$PIECE(XTL,"(")
+3 IF '$DATA(LN)
SET LN=N
IF LN<N
DO CLOSE
KILL NX
FOR NX=N:10:60
IF '$DATA(NX(NX+10))
SET NX(NX)=""
IF NX<60
SET NX(NX+20)=""
+4 IF XTZX1'="PROC "!(XTZX'="PROC ")
WRITE !
IF LN'=N!(XTZX1'="GOTO "&(XTZX1'="QUIT "))
FOR NX=0:0
SET NX=$ORDER(NX(NX))
IF NX=""
QUIT
WRITE ?NX,"|"
+5 SET LN=N
SET N=$SELECT(XTZX="LABEL":N-$LENGTH(X),1:N-($LENGTH(X)\2))
+6 IF $Y+5+(XTREF+1\2)>IOSL
DO WAIT
IF XT=U
QUIT
WRITE !,?N,X
SET XTZX1=XTZX
+7 FOR NX=0:0
SET NX=$ORDER(NX(NX))
IF NX=""
QUIT
IF $X<(NX-1)
WRITE ?NX,"|"
+8 QUIT
+9 ;
WAIT ; Skip to top of next page
+1 FOR K=1:1:4
IF ($Y+4+(XTREF+1\2))'<IOSL
QUIT
WRITE !
+2 IF XTREF>0
WRITE !,"The following references may be selected for expansion..."
+3 IF XTREF>0
FOR JK=1:1:(XTREF+1\2)
WRITE !?5,$JUSTIFY(JK,2),". ",^TMP($JOB,XTLEV,"X",JK)
SET JL=JK+(XTREF+1\2)
IF JL'>XTREF
WRITE ?30,$JUSTIFY(JL,2),". ",^(JL)
+4 IF XTREF>0
WRITE !?16,"Select LINE^ROUTINE to expand (1 to ",XTREF," ) or"
+5 IF 1
SET XT=""
IF IOST["C-"
READ !?16,"Press RETURN to continue, '^' to halt: ",XT:DTIME
IF '$TEST
SET XT=U
+6 IF XT>0&(XT'>XTREF)
SET XTSLINE(XTLEV)=XTSLINE
SET XTZX1(XTLEV)=XTZX1
SET XTLINE=^TMP($JOB,XTLEV,"X",+XT)
SET XTROU=$PIECE(XTLINE,U,2)
SET XTLINE=$PIECE(XTLINE,U,1)
SET XTLEV=XTLEV+1
+7 IF XT>0&(XT'>XTREF)
DO NODE^XTFCE
SET XTLINE=XTLINE(XTLEV)
SET XTROU=XTROU(XTLEV)
SET Z=XTSLINE(XTLEV)
SET XTZX1=XTZX1(XTLEV)
+8 SET XTZX1=XTZX1
SET XTSLINE=Z
WRITE @IOF
+9 SET XTREF=0
KILL ^TMP($JOB,XTLEV,"C"),^("X")
+10 QUIT
+11 ;
CLOSE ; Close previous nesting level
+1 SET IX1=$SELECT(LN>1:LN,1:0)
SET IX2=IX1+19
IF XTZX1="GOTO "!(XTZX1="QUIT ")
SET IX1=IX1+10
WRITE !
IF IX1'>LN
WRITE ?IX1,"|"
IF IX1>LN
WRITE ?IX1
FOR IX3=0:0
IF ($X'<(IX2+1))
QUIT
WRITE "_"
+2 WRITE "|"
FOR NX=-1:0
SET NX=$ORDER(NX(NX))
IF NX=""
QUIT
IF $X<(NX-1)
WRITE ?NX,"|"
+3 SET LN=$SELECT(LN>1:LN,1:0)+10
IF LN<N
SET XTZX1=" "
GOTO CLOSE
+4 SET LN=LN-1
+5 QUIT
