XTFC0 ;SF-ISC.SEA/JLI - FLOW CHART GENERATOR FOR MUMPS ROUTINES ;9/21/93 09:44 ;
;;7.3;TOOLKIT;;Apr 25, 1995
LINE ; Analyze one line of routine ROU
I '$D(XTEXT) S XTOFF="",XTFFLG=0 I XTIFLG>0 S XTCOND=0,XTIFLG=0 ; XTIFLG counts number of IFs on line
S XTXB=X D SCHAR ; SET UP DUPLICATES IN XTXB AND X, SCHAR MARKS AREAS IN XTXB THAT ARE SURROUNDED BY QUOTES OR PARENTHESES SO THEY ARE RECOGNIZED AS SPECIAL
I $E(XTXB,1)=" " S XTXB=$E(XTXB,2,999),X=$E(X,2,999)
E D LABEL
S XTDPER=0 D PARSE ; XTDPER WILL COUNT NUMBER OF PERIODS AT BEGINNING OF LINE
K XTXB,X,XTXB1,XTX1B,XTII,XTIK
Q
;
PARSE ; Parse out commands
I $E(XTXB,1)=" " S XTXB=$E(XTXB,2,$L(XTXB)),X=$E(X,2,$L(X)) G PARSE
I $E(XTXB,1)="." S XTXB=$E(XTXB,2,$L(XTXB)),X=$E(X,2,$L(X)),XTDPER=XTDPER+1 G PARSE
I $D(XTEXT(XTDPER+1)) D
. S XTEXT(0)=X,XTEXTB(0)=XTXB,XTDPER=XTDPER+1
. S X="ENAD "_XTEXT(XTDPER),XTXB="ENAD "_XTEXTB(XTDPER) K XTEXT(XTDPER),XTEXTB(XTDPER) S ZI=$G(ZI)+1,XZ(ZI)=X,XZB(ZI)=XTXB
. D PARS1
. S XTDPER=XTDPER-1,X=XTEXT(0),XTXB=XTEXTB(0) K XTEXT(0),XTEXTB(0)
I XTDPER=0 S XTOFF="",XTFFLG=0 I XTIFLG>0 S XTCOND=0,XTIFLG=0
I XTDPER>0 S XTOFF=XTOFF(XTDPER),XTFFLG=XTFFLG(XTDPER),XTCOND=XTCOND(XTDPER),XTIFLG=XTIFLG(XTDPER)
PARS1 ;
Q:XTXB="" I $E(XTXB,1)=" " S XTXB=$E(XTXB,2,$L(XTXB)),X=$E(X,2,$L(X)) G PARS1
S C=$E(XTXB,1) I C=";" Q ; Ignore comments
S XTXO=$S($L($P(XTXB,":"))<$L($P(XTXB," ")):$P(XTXB,":"),1:$P(XTXB," "))
F J=1:1 S XTCOM=$T(COMND+J) Q:XTCOM="" S K=0 S M=$P(XTCOM,";;",3) S:XTXO=M K=1 S:K=0 M=$P(XTCOM,";;",2) S:XTXO=M K=1 I K=1 D PARS2 Q
I XTCOM="",$E(XTXO)="Z" S XTCOM=$T(Z),M=XTXO D PARS2 Q
I XTCOM="" W !,X S XTXB1=$P(XTXB," ",1),XTXB=$P(XTXB," ",2,999),X=$E(X,$L(XTXB1)+2,$L(X))
G:X]"" PARS1
K C,J,XTCOM,K,M,XTXB1
Q
PARS2 ;
S XTXB=$E(XTXB,$L(M)+1,999),X=$E(X,$L(M)+1,999),XTLOC=$P(XTCOM,";;",4),XTOCOND=0
D:$E(XTXB,1)=":" OPCOND
I $E(XTXB,1,2)=" "&($E(M)="D"!($E(M)="F")) S XTARG="&ARGLS"_(XTDPER+1)_" ",XTXB=XTARG_$E(XTXB,3,999),X=XTARG_$E(X,3,999)
S:$E(XTXB,1)=" " XTXB=$E(XTXB,2,999),X=$E(X,2,999)
D @XTLOC D:XTOCOND ENDCOND
K XTLOC,XTOCOND
Q
;
OPCOND ;
S XTXB1=$P(XTXB," ",1),XTXB=$E(XTXB,$L(XTXB1)+1,999),XTX1=$E(X,2,$L(XTXB1)),X=$E(X,$L(XTXB1)+1,$L(X)),XTENTR=XTENTR+1,XTCOND=XTCOND+1,XTOCOND=1,^TMP($J,XTLEV,"FC",XTENTR,"DECIS")=XTOFF_"< "_XTX1_" >",XTOFF=XTOFF_"...."
Q
;
ENDCOND ;
S XTCOND=XTCOND-1,XTOCOND=0,XTOFF=$E(XTOFF,1,$L(XTOFF)-4)
Q
;
LABEL ;
S XTX1B=$P(XTXB," ",1),XTXB=$P(XTXB," ",2,999),XTX1=$E(X,1,$L(XTX1B)),X=$E(X,$L(XTX1B)+2,$L(X)) S XTX2="" I XTX1["(" S XTX2="("_$P(XTX1,"(",2,99),XTX1=$P(XTX1,"(")
S XTENTR=XTENTR+1,^TMP($J,XTLEV,"FC",XTENTR,"LABEL")=XTX1_"^"_XTROU_XTX2_" ====================> "
Q
;
SCHAR ;
F XTII=1:1:$L(XTXB) I $E(XTXB,XTII)="""" D ; PROCESS QUOTE
. S XTXB=$E(XTXB,1,XTII-1)_"."_$E(XTXB,XTII+1,$L(XTXB))
. F XTIK=XTII+1:1:$L(XTXB) S XTXB=$E(XTXB,1,XTIK-1)_"."_$E(XTXB,XTIK+1,$L(XTXB)) I $E(X,XTIK)="""" Q:$E(X,XTIK+1)'="""" S XTIK=XTIK+1,XTXB=$E(XTXB,1,XTIK-1)_"."_$E(XTXB,XTIK+1,$L(XTXB))
F XTII=1:1:$L(XTXB) I $E(XTXB,XTII)="(" D K XTPAR ; PROCESS PARENS
. S XTPAR=1,XTXB=$E(XTXB,1,XTII-1)_"."_$E(XTXB,XTII+1,$L(XTXB))
. F XTIK=XTII+1:1:$L(XTXB) Q:XTPAR=0 S C=$E(XTXB,XTIK),XTPAR=XTPAR+$S(C="(":1,C=")":-1,1:0),XTXB=$E(XTXB,1,XTIK-1)_"."_$E(XTXB,XTIK+1,$L(XTXB))
Q
;
CLEAR ; Used to clear possible arrays before next routine.
K XTDPER,XTOFF,XTCOND,XTEXT,XTEXTB,XTIFLG,XTFFLG,ZI,XZ,XZB
Q
;
COMND ;
B ;;B;;BREAK;;BREAK^XTFC1
C ;;C;;CLOSE;;CLOSE^XTFC1
D ;;D;;DO;;DO^XTFC1
E1 ;;ENAD;;ENAD;;ENAD^XTFC1
E ;;E;;ELSE;;ELSE^XTFC1
ESTART ;;ESTA;;ESTART;;ESTART^XTFC1
ESTOP ;;ESTO;;ESTOP;;ESTOP^XTFC1
ETRIG ;;ETR;;ETRIGGER;;ETRIG^XTFC1
F ;;F;;FOR;;FOR^XTFC1
G ;;G;;GOTO;;GO^XTFC1
H1 ;;H;;HALT;;HALT^XTFC1
H2 ;;H;;HANG;;HALT^XTFC1
I ;;I;;IF;;IF^XTFC1
J ;;J;;JOB;;JOB^XTFC1
K ;;K;;KILL;;KILL^XTFC1
L ;;L;;LOCK;;LOCK^XTFC1
M ;;M;;MERGE;;MERGE^XTFC1
N ;;N;;NEW;;NEW^XTFC1
O ;;O;;OPEN;;OPEN^XTFC1
Q ;;Q;;QUIT;;QUIT^XTFC1
R ;;R;;READ;;READ^XTFC1
S ;;S;;SET;;SET^XTFC1
U ;;U;;USE;;USE^XTFC1
V ;;V;;VIEW;;VIEW^XTFC1
W ;;W;;WRITE;;WRITE^XTFC1
X ;;X;;XECUTE;;XECUT^XTFC1
Z ;;Z;;Z;;ZCMND^XTFC1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTFC0 4175 printed Nov 22, 2024@17:50:48 Page 2
XTFC0 ;SF-ISC.SEA/JLI - FLOW CHART GENERATOR FOR MUMPS ROUTINES ;9/21/93 09:44 ;
+1 ;;7.3;TOOLKIT;;Apr 25, 1995
LINE ; Analyze one line of routine ROU
+1 ; XTIFLG counts number of IFs on line
IF '$DATA(XTEXT)
SET XTOFF=""
SET XTFFLG=0
IF XTIFLG>0
SET XTCOND=0
SET XTIFLG=0
+2 ; SET UP DUPLICATES IN XTXB AND X, SCHAR MARKS AREAS IN XTXB THAT ARE SURROUNDED BY QUOTES OR PARENTHESES SO THEY ARE RECOGNIZED AS SPECIAL
SET XTXB=X
DO SCHAR
+3 IF $EXTRACT(XTXB,1)=" "
SET XTXB=$EXTRACT(XTXB,2,999)
SET X=$EXTRACT(X,2,999)
+4 IF '$TEST
DO LABEL
+5 ; XTDPER WILL COUNT NUMBER OF PERIODS AT BEGINNING OF LINE
SET XTDPER=0
DO PARSE
+6 KILL XTXB,X,XTXB1,XTX1B,XTII,XTIK
+7 QUIT
+8 ;
PARSE ; Parse out commands
+1 IF $EXTRACT(XTXB,1)=" "
SET XTXB=$EXTRACT(XTXB,2,$LENGTH(XTXB))
SET X=$EXTRACT(X,2,$LENGTH(X))
GOTO PARSE
+2 IF $EXTRACT(XTXB,1)="."
SET XTXB=$EXTRACT(XTXB,2,$LENGTH(XTXB))
SET X=$EXTRACT(X,2,$LENGTH(X))
SET XTDPER=XTDPER+1
GOTO PARSE
+3 IF $DATA(XTEXT(XTDPER+1))
Begin DoDot:1
+4 SET XTEXT(0)=X
SET XTEXTB(0)=XTXB
SET XTDPER=XTDPER+1
+5 SET X="ENAD "_XTEXT(XTDPER)
SET XTXB="ENAD "_XTEXTB(XTDPER)
KILL XTEXT(XTDPER),XTEXTB(XTDPER)
SET ZI=$GET(ZI)+1
SET XZ(ZI)=X
SET XZB(ZI)=XTXB
+6 DO PARS1
+7 SET XTDPER=XTDPER-1
SET X=XTEXT(0)
SET XTXB=XTEXTB(0)
KILL XTEXT(0),XTEXTB(0)
End DoDot:1
+8 IF XTDPER=0
SET XTOFF=""
SET XTFFLG=0
IF XTIFLG>0
SET XTCOND=0
SET XTIFLG=0
+9 IF XTDPER>0
SET XTOFF=XTOFF(XTDPER)
SET XTFFLG=XTFFLG(XTDPER)
SET XTCOND=XTCOND(XTDPER)
SET XTIFLG=XTIFLG(XTDPER)
PARS1 ;
+1 if XTXB=""
QUIT
IF $EXTRACT(XTXB,1)=" "
SET XTXB=$EXTRACT(XTXB,2,$LENGTH(XTXB))
SET X=$EXTRACT(X,2,$LENGTH(X))
GOTO PARS1
+2 ; Ignore comments
SET C=$EXTRACT(XTXB,1)
IF C=";"
QUIT
+3 SET XTXO=$SELECT($LENGTH($PIECE(XTXB,":"))<$LENGTH($PIECE(XTXB," ")):$PIECE(XTXB,":"),1:$PIECE(XTXB," "))
+4 FOR J=1:1
SET XTCOM=$TEXT(COMND+J)
if XTCOM=""
QUIT
SET K=0
SET M=$PIECE(XTCOM,";;",3)
if XTXO=M
SET K=1
if K=0
SET M=$PIECE(XTCOM,";;",2)
if XTXO=M
SET K=1
IF K=1
DO PARS2
QUIT
+5 IF XTCOM=""
IF $EXTRACT(XTXO)="Z"
SET XTCOM=$TEXT(Z)
SET M=XTXO
DO PARS2
QUIT
+6 IF XTCOM=""
WRITE !,X
SET XTXB1=$PIECE(XTXB," ",1)
SET XTXB=$PIECE(XTXB," ",2,999)
SET X=$EXTRACT(X,$LENGTH(XTXB1)+2,$LENGTH(X))
+7 if X]""
GOTO PARS1
+8 KILL C,J,XTCOM,K,M,XTXB1
+9 QUIT
PARS2 ;
+1 SET XTXB=$EXTRACT(XTXB,$LENGTH(M)+1,999)
SET X=$EXTRACT(X,$LENGTH(M)+1,999)
SET XTLOC=$PIECE(XTCOM,";;",4)
SET XTOCOND=0
+2 if $EXTRACT(XTXB,1)="
DO OPCOND
+3 IF $EXTRACT(XTXB,1,2)=" "&($EXTRACT(M)="D"!($EXTRACT(M)="F"))
SET XTARG="&ARGLS"_(XTDPER+1)_" "
SET XTXB=XTARG_$EXTRACT(XTXB,3,999)
SET X=XTARG_$EXTRACT(X,3,999)
+4 if $EXTRACT(XTXB,1)=" "
SET XTXB=$EXTRACT(XTXB,2,999)
SET X=$EXTRACT(X,2,999)
+5 DO @XTLOC
if XTOCOND
DO ENDCOND
+6 KILL XTLOC,XTOCOND
+7 QUIT
+8 ;
OPCOND ;
+1 SET XTXB1=$PIECE(XTXB," ",1)
SET XTXB=$EXTRACT(XTXB,$LENGTH(XTXB1)+1,999)
SET XTX1=$EXTRACT(X,2,$LENGTH(XTXB1))
SET X=$EXTRACT(X,$LENGTH(XTXB1)+1,$LENGTH(X))
SET XTENTR=XTENTR+1
SET XTCOND=XTCOND+1
SET XTOCOND=1
SET ^TMP($JOB,XTLEV,"FC",XTENTR,"DECIS")=XTOFF_"< "_XTX1_" >"
SET XTOFF=XTOFF_"...."
+2 QUIT
+3 ;
ENDCOND ;
+1 SET XTCOND=XTCOND-1
SET XTOCOND=0
SET XTOFF=$EXTRACT(XTOFF,1,$LENGTH(XTOFF)-4)
+2 QUIT
+3 ;
LABEL ;
+1 SET XTX1B=$PIECE(XTXB," ",1)
SET XTXB=$PIECE(XTXB," ",2,999)
SET XTX1=$EXTRACT(X,1,$LENGTH(XTX1B))
SET X=$EXTRACT(X,$LENGTH(XTX1B)+2,$LENGTH(X))
SET XTX2=""
IF XTX1["("
SET XTX2="("_$PIECE(XTX1,"(",2,99)
SET XTX1=$PIECE(XTX1,"(")
+2 SET XTENTR=XTENTR+1
SET ^TMP($JOB,XTLEV,"FC",XTENTR,"LABEL")=XTX1_"^"_XTROU_XTX2_" ====================> "
+3 QUIT
+4 ;
SCHAR ;
+1 ; PROCESS QUOTE
FOR XTII=1:1:$LENGTH(XTXB)
IF $EXTRACT(XTXB,XTII)=""""
Begin DoDot:1
+2 SET XTXB=$EXTRACT(XTXB,1,XTII-1)_"."_$EXTRACT(XTXB,XTII+1,$LENGTH(XTXB))
+3 FOR XTIK=XTII+1:1:$LENGTH(XTXB)
SET XTXB=$EXTRACT(XTXB,1,XTIK-1)_"."_$EXTRACT(XTXB,XTIK+1,$LENGTH(XTXB))
IF $EXTRACT(X,XTIK)=""""
if $EXTRACT(X,XTIK+1)'=""""
QUIT
SET XTIK=XTIK+1
SET XTXB=$EXTRACT(XTXB,1,XTIK-1)_"."_$EXTRACT(XTXB,XTIK+1,$LENGTH(XTXB))
End DoDot:1
+4 ; PROCESS PARENS
FOR XTII=1:1:$LENGTH(XTXB)
IF $EXTRACT(XTXB,XTII)="("
Begin DoDot:1
+5 SET XTPAR=1
SET XTXB=$EXTRACT(XTXB,1,XTII-1)_"."_$EXTRACT(XTXB,XTII+1,$LENGTH(XTXB))
+6 FOR XTIK=XTII+1:1:$LENGTH(XTXB)
if XTPAR=0
QUIT
SET C=$EXTRACT(XTXB,XTIK)
SET XTPAR=XTPAR+$SELECT(C="(":1,C=")":-1,1:0)
SET XTXB=$EXTRACT(XTXB,1,XTIK-1)_"."_$EXTRACT(XTXB,XTIK+1,$LENGTH(XTXB))
End DoDot:1
KILL XTPAR
+7 QUIT
+8 ;
CLEAR ; Used to clear possible arrays before next routine.
+1 KILL XTDPER,XTOFF,XTCOND,XTEXT,XTEXTB,XTIFLG,XTFFLG,ZI,XZ,XZB
+2 QUIT
+3 ;
COMND ;
B ;;B;;BREAK;;BREAK^XTFC1
C ;;C;;CLOSE;;CLOSE^XTFC1
D ;;D;;DO;;DO^XTFC1
E1 ;;ENAD;;ENAD;;ENAD^XTFC1
E ;;E;;ELSE;;ELSE^XTFC1
ESTART ;;ESTA;;ESTART;;ESTART^XTFC1
ESTOP ;;ESTO;;ESTOP;;ESTOP^XTFC1
ETRIG ;;ETR;;ETRIGGER;;ETRIG^XTFC1
F ;;F;;FOR;;FOR^XTFC1
G ;;G;;GOTO;;GO^XTFC1
H1 ;;H;;HALT;;HALT^XTFC1
H2 ;;H;;HANG;;HALT^XTFC1
I ;;I;;IF;;IF^XTFC1
J ;;J;;JOB;;JOB^XTFC1
K ;;K;;KILL;;KILL^XTFC1
L ;;L;;LOCK;;LOCK^XTFC1
M ;;M;;MERGE;;MERGE^XTFC1
N ;;N;;NEW;;NEW^XTFC1
O ;;O;;OPEN;;OPEN^XTFC1
Q ;;Q;;QUIT;;QUIT^XTFC1
R ;;R;;READ;;READ^XTFC1
S ;;S;;SET;;SET^XTFC1
U ;;U;;USE;;USE^XTFC1
V ;;V;;VIEW;;VIEW^XTFC1
W ;;W;;WRITE;;WRITE^XTFC1
X ;;X;;XECUTE;;XECUT^XTFC1
Z ;;Z;;Z;;ZCMND^XTFC1
