1 | XTFC0 ;SF-ISC.SEA/JLI - FLOW CHART GENERATOR FOR MUMPS ROUTINES ;9/21/93 09:44 ;
|
---|
2 | ;;7.3;TOOLKIT;;Apr 25, 1995
|
---|
3 | LINE ; Analyze one line of routine ROU
|
---|
4 | I '$D(XTEXT) S XTOFF="",XTFFLG=0 I XTIFLG>0 S XTCOND=0,XTIFLG=0 ; XTIFLG counts number of IFs on line
|
---|
5 | 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
|
---|
6 | I $E(XTXB,1)=" " S XTXB=$E(XTXB,2,999),X=$E(X,2,999)
|
---|
7 | E D LABEL
|
---|
8 | S XTDPER=0 D PARSE ; XTDPER WILL COUNT NUMBER OF PERIODS AT BEGINNING OF LINE
|
---|
9 | K XTXB,X,XTXB1,XTX1B,XTII,XTIK
|
---|
10 | Q
|
---|
11 | ;
|
---|
12 | PARSE ; Parse out commands
|
---|
13 | I $E(XTXB,1)=" " S XTXB=$E(XTXB,2,$L(XTXB)),X=$E(X,2,$L(X)) G PARSE
|
---|
14 | I $E(XTXB,1)="." S XTXB=$E(XTXB,2,$L(XTXB)),X=$E(X,2,$L(X)),XTDPER=XTDPER+1 G PARSE
|
---|
15 | I $D(XTEXT(XTDPER+1)) D
|
---|
16 | . S XTEXT(0)=X,XTEXTB(0)=XTXB,XTDPER=XTDPER+1
|
---|
17 | . 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
|
---|
18 | . D PARS1
|
---|
19 | . S XTDPER=XTDPER-1,X=XTEXT(0),XTXB=XTEXTB(0) K XTEXT(0),XTEXTB(0)
|
---|
20 | I XTDPER=0 S XTOFF="",XTFFLG=0 I XTIFLG>0 S XTCOND=0,XTIFLG=0
|
---|
21 | I XTDPER>0 S XTOFF=XTOFF(XTDPER),XTFFLG=XTFFLG(XTDPER),XTCOND=XTCOND(XTDPER),XTIFLG=XTIFLG(XTDPER)
|
---|
22 | PARS1 ;
|
---|
23 | Q:XTXB="" I $E(XTXB,1)=" " S XTXB=$E(XTXB,2,$L(XTXB)),X=$E(X,2,$L(X)) G PARS1
|
---|
24 | S C=$E(XTXB,1) I C=";" Q ; Ignore comments
|
---|
25 | S XTXO=$S($L($P(XTXB,":"))<$L($P(XTXB," ")):$P(XTXB,":"),1:$P(XTXB," "))
|
---|
26 | 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
|
---|
27 | I XTCOM="",$E(XTXO)="Z" S XTCOM=$T(Z),M=XTXO D PARS2 Q
|
---|
28 | I XTCOM="" W !,X S XTXB1=$P(XTXB," ",1),XTXB=$P(XTXB," ",2,999),X=$E(X,$L(XTXB1)+2,$L(X))
|
---|
29 | G:X]"" PARS1
|
---|
30 | K C,J,XTCOM,K,M,XTXB1
|
---|
31 | Q
|
---|
32 | PARS2 ;
|
---|
33 | S XTXB=$E(XTXB,$L(M)+1,999),X=$E(X,$L(M)+1,999),XTLOC=$P(XTCOM,";;",4),XTOCOND=0
|
---|
34 | D:$E(XTXB,1)=":" OPCOND
|
---|
35 | 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)
|
---|
36 | S:$E(XTXB,1)=" " XTXB=$E(XTXB,2,999),X=$E(X,2,999)
|
---|
37 | D @XTLOC D:XTOCOND ENDCOND
|
---|
38 | K XTLOC,XTOCOND
|
---|
39 | Q
|
---|
40 | ;
|
---|
41 | OPCOND ;
|
---|
42 | 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_"...."
|
---|
43 | Q
|
---|
44 | ;
|
---|
45 | ENDCOND ;
|
---|
46 | S XTCOND=XTCOND-1,XTOCOND=0,XTOFF=$E(XTOFF,1,$L(XTOFF)-4)
|
---|
47 | Q
|
---|
48 | ;
|
---|
49 | LABEL ;
|
---|
50 | 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,"(")
|
---|
51 | S XTENTR=XTENTR+1,^TMP($J,XTLEV,"FC",XTENTR,"LABEL")=XTX1_"^"_XTROU_XTX2_" ====================> "
|
---|
52 | Q
|
---|
53 | ;
|
---|
54 | SCHAR ;
|
---|
55 | F XTII=1:1:$L(XTXB) I $E(XTXB,XTII)="""" D ; PROCESS QUOTE
|
---|
56 | . S XTXB=$E(XTXB,1,XTII-1)_"."_$E(XTXB,XTII+1,$L(XTXB))
|
---|
57 | . 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))
|
---|
58 | F XTII=1:1:$L(XTXB) I $E(XTXB,XTII)="(" D K XTPAR ; PROCESS PARENS
|
---|
59 | . S XTPAR=1,XTXB=$E(XTXB,1,XTII-1)_"."_$E(XTXB,XTII+1,$L(XTXB))
|
---|
60 | . 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))
|
---|
61 | Q
|
---|
62 | ;
|
---|
63 | CLEAR ; Used to clear possible arrays before next routine.
|
---|
64 | K XTDPER,XTOFF,XTCOND,XTEXT,XTEXTB,XTIFLG,XTFFLG,ZI,XZ,XZB
|
---|
65 | Q
|
---|
66 | ;
|
---|
67 | COMND ;
|
---|
68 | B ;;B;;BREAK;;BREAK^XTFC1
|
---|
69 | C ;;C;;CLOSE;;CLOSE^XTFC1
|
---|
70 | D ;;D;;DO;;DO^XTFC1
|
---|
71 | E1 ;;ENAD;;ENAD;;ENAD^XTFC1
|
---|
72 | E ;;E;;ELSE;;ELSE^XTFC1
|
---|
73 | ESTART ;;ESTA;;ESTART;;ESTART^XTFC1
|
---|
74 | ESTOP ;;ESTO;;ESTOP;;ESTOP^XTFC1
|
---|
75 | ETRIG ;;ETR;;ETRIGGER;;ETRIG^XTFC1
|
---|
76 | F ;;F;;FOR;;FOR^XTFC1
|
---|
77 | G ;;G;;GOTO;;GO^XTFC1
|
---|
78 | H1 ;;H;;HALT;;HALT^XTFC1
|
---|
79 | H2 ;;H;;HANG;;HALT^XTFC1
|
---|
80 | I ;;I;;IF;;IF^XTFC1
|
---|
81 | J ;;J;;JOB;;JOB^XTFC1
|
---|
82 | K ;;K;;KILL;;KILL^XTFC1
|
---|
83 | L ;;L;;LOCK;;LOCK^XTFC1
|
---|
84 | M ;;M;;MERGE;;MERGE^XTFC1
|
---|
85 | N ;;N;;NEW;;NEW^XTFC1
|
---|
86 | O ;;O;;OPEN;;OPEN^XTFC1
|
---|
87 | Q ;;Q;;QUIT;;QUIT^XTFC1
|
---|
88 | R ;;R;;READ;;READ^XTFC1
|
---|
89 | S ;;S;;SET;;SET^XTFC1
|
---|
90 | U ;;U;;USE;;USE^XTFC1
|
---|
91 | V ;;V;;VIEW;;VIEW^XTFC1
|
---|
92 | W ;;W;;WRITE;;WRITE^XTFC1
|
---|
93 | X ;;X;;XECUTE;;XECUT^XTFC1
|
---|
94 | Z ;;Z;;Z;;ZCMND^XTFC1
|
---|