XTFC1.m

XTFC1 ;SF-ISC.SEA/JLI -  FLOW CHART GENERATION ;12/7/95  14:50 [ 04/02/2003   8:47 AM ]

 ;;7.3;TOOLKIT;**1001**;APR 1, 2003

 ;;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

XTFC1     ;SF-ISC.SEA/JLI -  FLOW CHART GENERATION ;12/7/95  14:50 [ 04/02/2003   8:47 AM ]

 +1       ;;7.3;TOOLKIT;**1001**;APR 1, 2003

 +2       ;;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