XTFC0.m

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 ---XTFC0   4175     printed  Mar 13, 2025@21:45:56                                                                                                                                                                                                       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