XTFCE.m

XTFCE ;SF-ISC.SEA/JLI - SELECTIVE FLOW CHARTS 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

EN ;

 W !,"Select ROUTINE or LABEL^ROUTINE: " R X:DTIME G:'$T!(X="")!(X=U) EXIT S XTX=X,X=$S(X[U:$P(X,U,2),1:X) X ^%ZOSF("TEST") I '$T W $C(7),"  ??" G XTFCE

 K ^TMP($J) S XTROU=X I XTX[U S XTLINE=$P(XTX,U,1) I XTLINE]"" S XTLEV=1 D NODE G XTFCE

 ;

ROU ; Display Entry Points or identified lines of routine

 S XTLEV=0 D GETROU S XTM=0 F I=1:1 Q:'$D(^TMP($J,XTLEV,"T",I,0))  S J=^(0) Q:J=""  I $E(J,1)'=" " S XTM=XTM+1,^TMP($J,XTLEV,"X",XTM)=$P(J," ",1)

 ;

ROU1 G:'$D(^TMP($J,0)) XTFCE W !,"The following labels are present in routine ",XTROU," and can be",!,"selected for expansion.",! ;, or enter * for the entire routine.",!

 F J=1:1:15 Q:J>XTM  W !,$J(J,2),".  ",^TMP($J,XTLEV,"X",J) F K=J+15:15:60 Q:K>XTM  W ?(15*(K-1\15)),$J(K,2),".  ",^(K)

 W !!,"Select LABEL by number (1 to ",XTM,"): " R X:DTIME G:'$T!(X="")!(X[U) EXIT I X<1!(X>XTM) W $C(7),"  ??" G ROU1

 S XTLINE=^TMP($J,XTLEV,"X",+X),XTLEV=1 D NODE G ROU1

 ;

ALL ;

 Q

NODE ;

 K XTEXT,XTEXTB,^TMP($J,XTLEV)

 S XTLINE=$P(XTLINE,"("),XTROU(XTLEV)=XTROU,XTLINE(XTLEV)=XTLINE,X=XTROU D GETROU

 S XTIL=0 F I=1:1 Q:'$D(^TMP($J,XTLEV,"T",I,0))  S J=^(0) I $P($P(J," ",1),"(")=XTLINE S XTIL=I Q

 I XTIL=0 W $C(7),"  ??  line ",XTLINE," not found in routine ",XTROU S XTLEV=XTLEV-1 Q

 S XTIFLG=0,XTTFLG=0,XTCOND=0,XTENTR=0 F I=XTIL:1 Q:XTTFLG!'$D(^TMP($J,XTLEV,"T",I,0))  S X=^(0) D LINE^XTFC0

 D ^XTFCE1

 S XT="",XTLEV=XTLEV-1

 Q

GETROU ; Get routine into ^TMP($J,XTLEV,"T",n)

 S X=$P(X,"("),DIF="^TMP($J,XTLEV,""T"",",XCNP=0 X ^%ZOSF("LOAD") K DIF,XCNP

 Q

 ;

EXIT ;

 K XT,XTCOND,XTENTR,XTIFLG,XTIJ,XTIL,XTL,XTL1,XTL2,XTLEV,XTLINE,XTM,XTNAM,XTPCOND,XTREF,XTROU,XTSLINE,XTTFLG,XTX,XTX1,XTX2,XTX2B,XTZA,XTZX,XTZX1,I,J,JK,JL,K,N,X,Y,Z

 Q

XTFCE     ;SF-ISC.SEA/JLI - SELECTIVE FLOW CHARTS 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

EN        ;

 +1        WRITE !,"Select ROUTINE or LABEL^ROUTINE: "

           READ X:DTIME

           IF '$TEST!(X="")!(X=U)

               GOTO EXIT

           SET XTX=X

           SET X=$SELECT(X[U:$PIECE(X,U,2),1:X)

           XECUTE ^%ZOSF("TEST")

           IF '$TEST

               WRITE $CHAR(7),"  ??"

               GOTO XTFCE

 +2        KILL ^TMP($JOB)

           SET XTROU=X

           IF XTX[U

               SET XTLINE=$PIECE(XTX,U,1)

               IF XTLINE]""

                   SET XTLEV=1

                   DO NODE

                   GOTO XTFCE

 +3       ;

ROU       ; Display Entry Points or identified lines of routine

 +1        SET XTLEV=0

           DO GETROU

           SET XTM=0

           FOR I=1:1

               IF '$DATA(^TMP($JOB,XTLEV,"T",I,0))

                   QUIT 

               SET J=^(0)

               IF J=""

                   QUIT 

               IF $EXTRACT(J,1)'=" "

                   SET XTM=XTM+1

                   SET ^TMP($JOB,XTLEV,"X",XTM)=$PIECE(J," ",1)

 +2       ;

ROU1      ;, or enter * for the entire routine.",!

           IF '$DATA(^TMP($JOB,0))

               GOTO XTFCE

           WRITE !,"The following labels are present in routine ",XTROU," and can be",!,"selected for expansion.",!

 +1        FOR J=1:1:15

               IF J>XTM

                   QUIT 

               WRITE !,$JUSTIFY(J,2),".  ",^TMP($JOB,XTLEV,"X",J)

               FOR K=J+15:15:60

                   IF K>XTM

                       QUIT 

                   WRITE ?(15*(K-1\15)),$JUSTIFY(K,2),".  ",^(K)

 +2        WRITE !!,"Select LABEL by number (1 to ",XTM,"): "

           READ X:DTIME

           IF '$TEST!(X="")!(X[U)

               GOTO EXIT

           IF X<1!(X>XTM)

               WRITE $CHAR(7),"  ??"

               GOTO ROU1

 +3        SET XTLINE=^TMP($JOB,XTLEV,"X",+X)

           SET XTLEV=1

           DO NODE

           GOTO ROU1

 +4       ;

ALL       ;

 +1        QUIT 

NODE      ;

 +1        KILL XTEXT,XTEXTB,^TMP($JOB,XTLEV)

 +2        SET XTLINE=$PIECE(XTLINE,"(")

           SET XTROU(XTLEV)=XTROU

           SET XTLINE(XTLEV)=XTLINE

           SET X=XTROU

           DO GETROU

 +3        SET XTIL=0

           FOR I=1:1

               IF '$DATA(^TMP($JOB,XTLEV,"T",I,0))

                   QUIT 

               SET J=^(0)

               IF $PIECE($PIECE(J," ",1),"(")=XTLINE

                   SET XTIL=I

                   QUIT 

 +4        IF XTIL=0

               WRITE $CHAR(7),"  ??  line ",XTLINE," not found in routine ",XTROU

               SET XTLEV=XTLEV-1

               QUIT 

 +5        SET XTIFLG=0

           SET XTTFLG=0

           SET XTCOND=0

           SET XTENTR=0

           FOR I=XTIL:1

               IF XTTFLG!'$DATA(^TMP($JOB,XTLEV,"T",I,0))

                   QUIT 

               SET X=^(0)

               DO LINE^XTFC0

 +6        DO ^XTFCE1

 +7        SET XT=""

           SET XTLEV=XTLEV-1

 +8        QUIT 

GETROU    ; Get routine into ^TMP($J,XTLEV,"T",n)

 +1        SET X=$PIECE(X,"(")

           SET DIF="^TMP($J,XTLEV,""T"","

           SET XCNP=0

           XECUTE ^%ZOSF("LOAD")

           KILL DIF,XCNP

 +2        QUIT 

 +3       ;

EXIT      ;

 +1        KILL XT,XTCOND,XTENTR,XTIFLG,XTIJ,XTIL,XTL,XTL1,XTL2,XTLEV,XTLINE,XTM,XTNAM,XTPCOND,XTREF,XTROU,XTSLINE,XTTFLG,XTX,XTX1,XTX2,XTX2B,XTZA,XTZX,XTZX1,I,J,JK,JL,K,N,X,Y,Z

 +2        QUIT