- XTFC1 ;SF-ISC.SEA/JLI - FLOW CHART GENERATION ;12/7/95 14:50
- ;;7.3;TOOLKIT;**8**;Apr 25, 1995
- SETIT ;
- W:IOST["C-" "."
- S XTX1B=$P(XTXB," ",1),XTXB=$P(XTXB," ",2,999),XTX1=$E(X,1,$L(XTX1B)),X=$E(X,$L(XTX1B)+2,$L(X))
- F XTIJ=0:0 Q:XTX1B="" S XTX2B=$P(XTX1B,",",1),XTX1B=$P(XTX1B,",",2,999),XTX2=$E(XTX1,1,$L(XTX2B)),XTX1=$E(XTX1,$L(XTX2)+2,$L(XTX1)) D SETIT1
- Q
- SETIT1 ;
- N % D PSET S:(XTNAM["DO"!(XTNAM["GOTO"))&($P(XTX2,"(")'["^") %=$P(XTX2,"(",2,99),XTX2=$P(XTX2,"(")_"^"_XTROU_$S($L(%):"("_%,1:"")
- S XTENTR=XTENTR+1,^TMP($J,XTLEV,"FC",XTENTR,XTNAM)=XTOFF_XTL1_XTX2_XTL2 D QTCHK,PCLR
- Q
- ;
- DO I $E(XTXB,1,6)'="&ARGLS"&(XTXB'="") S XTNAM="DO ",XTL1="[ ",XTL2=" ]" G SETIT
- I $D(XTEXT(0)) D S XTENTR=XTENTR+1,^TMP($J,XTLEV,"FC",XTENTR,"ARGLS")=XTOFF_"[REPEAT OF LAST ARGLESS DO "_XX_"]" S X=$P(X," ",2,999),XTXB=$P(XTXB," ",2,999) Q
- . S XX="" F ENAD1=1:1:(XTDPER+1) S XX=XX_"."
- S XTEXTB(XTDPER+1)=$P(XTXB," ",2,999),XTEXT(XTDPER+1)=$P(X," ",2,999),XTOFF(XTDPER+1)=XTOFF,XTIFLG(XTDPER+1)=XTIFLG,XTFFLG(XTDPER+1)=XTFFLG,XTCOND(XTDPER+1)=XTCOND
- D S X="",XTXB="",XTENTR=XTENTR+1,^TMP($J,XTLEV,"FC",XTENTR,"ARGLS")=XTOFF_"-- START OF ARGLESS DO "_XX_"--"
- . S XX="" F ENAD1=1:1:(XTDPER+1) S XX=XX_"."
- Q
- ENAD ; END OF NON ARGUMENT DO
- D S XTENTR=XTENTR+1,^TMP($J,XTLEV,"FC",XTENTR,"ENAD ")=XTOFF_"-- END OF ARGUMENTLESS DO "_XX_"--"
- . S XX="" F ENAD1=1:1:XTDPER S XX=XX_"."
- . S XTOFF=XTOFF(XTDPER),XTIFLG=XTIFLG(XTDPER),XTCOND=XTCOND(XTDPER),XTFFLG=XTFFLG(XTDPER)
- Q
- ;
- GO S XTNAM="GOTO ",XTL1="{ ",XTL2=" }" G SETIT
- ;
- KILL S XTNAM="PROC ",XTL1="KILL ",XTL2="" G SETIT
- ;
- LOCK S XTNAM="PROC ",XTL1="LOCK ",XTL2="" G SETIT
- MERGE S XTNAM="MERGE",XTL1="MERGE ",XTL2="" G SETIT
- ESTART S XTNAM="ESTAR",XTL1="ESTART ",XTL2="" G SETIT
- ESTOP S XTNAM="ESTOP",XTL1="ESTOP ",XTL2="" G SETIT
- ;
- ETRIG S XTNAM="ETRIG",XTL1="ETRIGGER ",XTL2="" G SETIT
- ;
- NEW S XTNAM="PROC ",XTL1="NEW ",XTL2="" G SETIT
- ;
- JOB S XTNAM="JOB ",XTL1="JOB ",XTL2="" G SETIT
- ;
- BREAK S XTNAM="PROC ",XTL1="BREAK ",XTL2="" G SETIT
- ;
- CLOSE S XTNAM="PROC ",XTL1="CLOSE ",XTL2="" G SETIT
- ;
- OPEN S XTNAM="PROC ",XTL1="OPEN ",XTL2="" G SETIT
- ;
- USE S XTNAM="PROC ",XTL1="USE ",XTL2="" G SETIT
- ;
- SET S XTNAM="PROC ",XTL1="SET ",XTL2="" G SETIT
- VIEW S XTNAM="VIEW ",XTL1="VIEW ",XTL2="" G SETIT
- ZCMND S XTNAM="ZCMND",XTL1=XTXO_" ",XTL2="" G SETIT
- ;
- HALT ;
- S XTX1B=$P(XTXB," ",1),XTXB=$P(XTXB," ",2,999),XTX1=$E(X,1,$L(XTX1B)),X=$E(X,$L(XTX1B)+2,$L(X)),XTENTR=XTENTR+1,^TMP($J,XTLEV,"FC",XTENTR,"HALT ")=XTOFF_" *** "_$S(XTX1>0:"HANG "_(+XTX1),1:"HALT")_" ***"
- Q
- ;
- READ ;
- S XTX1B=$P(XTXB," ",1),XTXB=$P(XTXB," ",2,999),XTX1=$E(X,1,$L(XTX1B)),X=$E(X,$L(XTX1B)+2,$L(X)),XTENTR=XTENTR+1,^TMP($J,XTLEV,"FC",XTENTR,"READ ")=XTOFF_"READ--- "_XTX1
- Q
- ;
- WRITE ;
- S XTX1B=$P(XTXB," ",1),XTXB=$P(XTXB," ",2,999),XTX1=$E(X,1,$L(XTX1B)),X=$E(X,$L(XTX1B)+2,$L(X)),XTENTR=XTENTR+1,^TMP($J,XTLEV,"FC",XTENTR,"WRITE")=XTOFF_"WRITE--- "_XTX1
- Q
- ;
- XECUT ;
- S XTX1B=$P(XTXB," ",1),XTXB=$P(XTXB," ",2,999),XTX1=$E(X,1,$L(XTX1B)),X=$E(X,$L(XTX1B)+2,$L(X)),XTENTR=XTENTR+1,^TMP($J,XTLEV,"FC",XTENTR,"PROC ")=XTOFF_"Xecute "_XTX1
- Q
- QUIT ; Quit command
- 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 XTENTR=XTENTR+1,^TMP($J,XTLEV,"FC",XTENTR,"QUIT ")=XTOFF_$S(XTFFLG=0:" *** QUIT"_$S(XTX1'="":" "_XTX1,1:"")_" ***",1:"( QUIT FOR "_$S(XTX1'="":" "_XTX1_" ",1:"")_")") I 'XTFFLG&(XTOFF="") S XTTFLG=1
- Q
- ;
- IF ;
- S XTX2B=$P(XTXB," ",1),XTXB=$P(XTXB," ",2,999),XTX1=$E(X,1,$L(XTX2B)),X=$E(X,$L(XTX2B)+2,$L(X))
- S XTCOND=XTCOND+1,XTIFLG=XTIFLG+1,XTENTR=XTENTR+1,^TMP($J,XTLEV,"FC",XTENTR,"IF ")=XTOFF_"< "_XTX1_" >",XTOFF=XTOFF_"...."
- Q
- ;
- FOR ;
- S XTXB1=$P(XTXB," ",1),XTXB=$P(XTXB," ",2,999),XTX1=$E(X,1,$L(XTXB1)),X=$E(X,$L(XTXB1)+2,999),XTENTR=XTENTR+1
- S ^TMP($J,XTLEV,"FC",XTENTR,"FOR ")=XTOFF_"F "_$S($E(XTX1,1,6)="&ARGLS":"",1:XTX1),XTOFF=XTOFF_" ",XTFFLG=1
- Q
- ;
- ELSE ;
- S XTENTR=XTENTR+1,XTCOND=XTCOND+1,XTIFLG=XTIFLG+1,^TMP($J,XTLEV,"FC",XTENTR,"ELSE ")=XTOFF_"< ELSE... >",XTOFF=XTOFF_"...."
- Q
- PSET ; Set post-conditional if it applies
- S XTPCOND=$S(XTX2B[":":1,1:0) Q:'XTPCOND
- S XTX2B=$P(XTX2B,":",1),XTXCOND=$E(XTX2,$L(XTX2B)+2,$L(XTX2)),XTX2=$E(XTX2,1,$L(XTX2B))
- S XTCOND=XTCOND+1,XTENTR=XTENTR+1,^TMP($J,XTLEV,"FC",XTENTR,"DECIS")=XTOFF_"< "_XTXCOND_" >",XTOFF=XTOFF_"...."
- Q
- ;
- PCLR ;
- Q:'XTPCOND
- S XTCOND=XTCOND-1,XTOFF=$E(XTOFF,1,$L(XTOFF)-4)
- Q
- QTCHK ; Check if Quit Flag should be set
- I XTNAM="GOTO "!(XTNAM="HALT ") I XTOFF="" S XTTFLG=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTFC1 4577 printed Mar 13, 2025@21:45:57 Page 2
- XTFC1 ;SF-ISC.SEA/JLI - FLOW CHART GENERATION ;12/7/95 14:50
- +1 ;;7.3;TOOLKIT;**8**;Apr 25, 1995
- SETIT ;
- +1 if IOST["C-"
- WRITE "."
- +2 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))
- +3 FOR XTIJ=0:0
- if XTX1B=""
- QUIT
- SET XTX2B=$PIECE(XTX1B,",",1)
- SET XTX1B=$PIECE(XTX1B,",",2,999)
- SET XTX2=$EXTRACT(XTX1,1,$LENGTH(XTX2B))
- SET XTX1=$EXTRACT(XTX1,$LENGTH(XTX2)+2,$LENGTH(XTX1))
- DO SETIT1
- +4 QUIT
- SETIT1 ;
- +1 NEW %
- DO PSET
- if (XTNAM["DO"!(XTNAM["GOTO"))&($PIECE(XTX2,"(")'["^")
- SET %=$PIECE(XTX2,"(",2,99)
- SET XTX2=$PIECE(XTX2,"(")_"^"_XTROU_$SELECT($LENGTH(%):"("_%,1:"")
- +2 SET XTENTR=XTENTR+1
- SET ^TMP($JOB,XTLEV,"FC",XTENTR,XTNAM)=XTOFF_XTL1_XTX2_XTL2
- DO QTCHK
- DO PCLR
- +3 QUIT
- +4 ;
- DO IF $EXTRACT(XTXB,1,6)'="&ARGLS"&(XTXB'="")
- SET XTNAM="DO "
- SET XTL1="[ "
- SET XTL2=" ]"
- GOTO SETIT
- +1 IF $DATA(XTEXT(0))
- Begin DoDot:1
- +2 SET XX=""
- FOR ENAD1=1:1:(XTDPER+1)
- SET XX=XX_"."
- End DoDot:1
- SET XTENTR=XTENTR+1
- SET ^TMP($JOB,XTLEV,"FC",XTENTR,"ARGLS")=XTOFF_"[REPEAT OF LAST ARGLESS DO "_XX_"]"
- SET X=$PIECE(X," ",2,999)
- SET XTXB=$PIECE(XTXB," ",2,999)
- QUIT
- +3 SET XTEXTB(XTDPER+1)=$PIECE(XTXB," ",2,999)
- SET XTEXT(XTDPER+1)=$PIECE(X," ",2,999)
- SET XTOFF(XTDPER+1)=XTOFF
- SET XTIFLG(XTDPER+1)=XTIFLG
- SET XTFFLG(XTDPER+1)=XTFFLG
- SET XTCOND(XTDPER+1)=XTCOND
- +4 Begin DoDot:1
- +5 SET XX=""
- FOR ENAD1=1:1:(XTDPER+1)
- SET XX=XX_"."
- End DoDot:1
- SET X=""
- SET XTXB=""
- SET XTENTR=XTENTR+1
- SET ^TMP($JOB,XTLEV,"FC",XTENTR,"ARGLS")=XTOFF_"-- START OF ARGLESS DO "_XX_"--"
- +6 QUIT
- ENAD ; END OF NON ARGUMENT DO
- +1 Begin DoDot:1
- +2 SET XX=""
- FOR ENAD1=1:1:XTDPER
- SET XX=XX_"."
- +3 SET XTOFF=XTOFF(XTDPER)
- SET XTIFLG=XTIFLG(XTDPER)
- SET XTCOND=XTCOND(XTDPER)
- SET XTFFLG=XTFFLG(XTDPER)
- End DoDot:1
- SET XTENTR=XTENTR+1
- SET ^TMP($JOB,XTLEV,"FC",XTENTR,"ENAD ")=XTOFF_"-- END OF ARGUMENTLESS DO "_XX_"--"
- +4 QUIT
- +5 ;
- GO SET XTNAM="GOTO "
- SET XTL1="{ "
- SET XTL2=" }"
- GOTO SETIT
- +1 ;
- KILL SET XTNAM="PROC "
- SET XTL1="KILL "
- SET XTL2=""
- GOTO SETIT
- +1 ;
- LOCK SET XTNAM="PROC "
- SET XTL1="LOCK "
- SET XTL2=""
- GOTO SETIT
- MERGE SET XTNAM="MERGE"
- SET XTL1="MERGE "
- SET XTL2=""
- GOTO SETIT
- ESTART SET XTNAM="ESTAR"
- SET XTL1="ESTART "
- SET XTL2=""
- GOTO SETIT
- ESTOP SET XTNAM="ESTOP"
- SET XTL1="ESTOP "
- SET XTL2=""
- GOTO SETIT
- +1 ;
- ETRIG SET XTNAM="ETRIG"
- SET XTL1="ETRIGGER "
- SET XTL2=""
- GOTO SETIT
- +1 ;
- NEW SET XTNAM="PROC "
- SET XTL1="NEW "
- SET XTL2=""
- GOTO SETIT
- +1 ;
- JOB SET XTNAM="JOB "
- SET XTL1="JOB "
- SET XTL2=""
- GOTO SETIT
- +1 ;
- BREAK SET XTNAM="PROC "
- SET XTL1="BREAK "
- SET XTL2=""
- GOTO SETIT
- +1 ;
- CLOSE SET XTNAM="PROC "
- SET XTL1="CLOSE "
- SET XTL2=""
- GOTO SETIT
- +1 ;
- OPEN SET XTNAM="PROC "
- SET XTL1="OPEN "
- SET XTL2=""
- GOTO SETIT
- +1 ;
- USE SET XTNAM="PROC "
- SET XTL1="USE "
- SET XTL2=""
- GOTO SETIT
- +1 ;
- SET SET XTNAM="PROC "
- SET XTL1="SET "
- SET XTL2=""
- GOTO SETIT
- VIEW SET XTNAM="VIEW "
- SET XTL1="VIEW "
- SET XTL2=""
- GOTO SETIT
- ZCMND SET XTNAM="ZCMND"
- SET XTL1=XTXO_" "
- SET XTL2=""
- GOTO SETIT
- +1 ;
- HALT ;
- +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 XTENTR=XTENTR+1
- SET ^TMP($JOB,XTLEV,"FC",XTENTR,"HALT ")=XTOFF_" *** "_$SELECT(XTX1>0:"HANG "_(+XTX1),1:"HALT")_" ***"
- +2 QUIT
- +3 ;
- READ ;
- +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 XTENTR=XTENTR+1
- SET ^TMP($JOB,XTLEV,"FC",XTENTR,"READ ")=XTOFF_"READ--- "_XTX1
- +2 QUIT
- +3 ;
- WRITE ;
- +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 XTENTR=XTENTR+1
- SET ^TMP($JOB,XTLEV,"FC",XTENTR,"WRITE")=XTOFF_"WRITE--- "_XTX1
- +2 QUIT
- +3 ;
- XECUT ;
- +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 XTENTR=XTENTR+1
- SET ^TMP($JOB,XTLEV,"FC",XTENTR,"PROC ")=XTOFF_"Xecute "_XTX1
- +2 QUIT
- QUIT ; Quit command
- +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))
- +2 SET XTENTR=XTENTR+1
- SET ^TMP($JOB,XTLEV,"FC",XTENTR,"QUIT ")=XTOFF_$SELECT(XTFFLG=0:" *** QUIT"_$SELECT(XTX1'="":" "_XTX1,1:"")_" ***",1:"( QUIT FOR "_$SELECT(XTX1'="":" "_XTX1_" ",1:"")_")")
- IF 'XTFFLG&(XTOFF="")
- SET XTTFLG=1
- +3 QUIT
- +4 ;
- IF ;
- +1 SET XTX2B=$PIECE(XTXB," ",1)
- SET XTXB=$PIECE(XTXB," ",2,999)
- SET XTX1=$EXTRACT(X,1,$LENGTH(XTX2B))
- SET X=$EXTRACT(X,$LENGTH(XTX2B)+2,$LENGTH(X))
- +2 SET XTCOND=XTCOND+1
- SET XTIFLG=XTIFLG+1
- SET XTENTR=XTENTR+1
- SET ^TMP($JOB,XTLEV,"FC",XTENTR,"IF ")=XTOFF_"< "_XTX1_" >"
- SET XTOFF=XTOFF_"...."
- +3 QUIT
- +4 ;
- FOR ;
- +1 SET XTXB1=$PIECE(XTXB," ",1)
- SET XTXB=$PIECE(XTXB," ",2,999)
- SET XTX1=$EXTRACT(X,1,$LENGTH(XTXB1))
- SET X=$EXTRACT(X,$LENGTH(XTXB1)+2,999)
- SET XTENTR=XTENTR+1
- +2 SET ^TMP($JOB,XTLEV,"FC",XTENTR,"FOR ")=XTOFF_"F "_$SELECT($EXTRACT(XTX1,1,6)="&ARGLS":"",1:XTX1)
- SET XTOFF=XTOFF_" "
- SET XTFFLG=1
- +3 QUIT
- +4 ;
- ELSE ;
- +1 SET XTENTR=XTENTR+1
- SET XTCOND=XTCOND+1
- SET XTIFLG=XTIFLG+1
- SET ^TMP($JOB,XTLEV,"FC",XTENTR,"ELSE ")=XTOFF_"< ELSE... >"
- SET XTOFF=XTOFF_"...."
- +2 QUIT
- PSET ; Set post-conditional if it applies
- +1 SET XTPCOND=$SELECT(XTX2B[":":1,1:0)
- if 'XTPCOND
- QUIT
- +2 SET XTX2B=$PIECE(XTX2B,":",1)
- SET XTXCOND=$EXTRACT(XTX2,$LENGTH(XTX2B)+2,$LENGTH(XTX2))
- SET XTX2=$EXTRACT(XTX2,1,$LENGTH(XTX2B))
- +3 SET XTCOND=XTCOND+1
- SET XTENTR=XTENTR+1
- SET ^TMP($JOB,XTLEV,"FC",XTENTR,"DECIS")=XTOFF_"< "_XTXCOND_" >"
- SET XTOFF=XTOFF_"...."
- +4 QUIT
- +5 ;
- PCLR ;
- +1 if 'XTPCOND
- QUIT
- +2 SET XTCOND=XTCOND-1
- SET XTOFF=$EXTRACT(XTOFF,1,$LENGTH(XTOFF)-4)
- +3 QUIT
- QTCHK ; Check if Quit Flag should be set
- +1 IF XTNAM="GOTO "!(XTNAM="HALT ")
- IF XTOFF=""
- SET XTTFLG=1
- +2 QUIT
