XTFCR.m

XTFCR ;SF-ISC.SEA/JLI - FLOW CHART GENERATOR FOR MUMPS ROUTINES ;9/21/93  09:53 ;

 ;;7.3;TOOLKIT;;Apr 25, 1995

 W !!,"FLOW CHART GENERATOR FOR MUMPS ROUTINES",!

 W !,"< COND >  = CONDITIONAL, if 'COND' is true code to the left is performed"

 W !!,"[ LINE^ROU ]   = DO or SUBROUTINE call to location LINE of routine ROU,",!,"                 control returns to commands following this in sequence"

 W !!,"{ LINE^ROU } = GO TO, control is transferred to the location LINE in",!,"               routine ROU.",!

ENTRY S XTLEV="A" K ^TMP($J),^UTILITY($J) X ^%ZOSF("RSEL") I '($D(^UTILITY($J))\10) G EXIT

 S %X="^UTILITY($J,",%Y="^TMP($J," D %XY^%RCR K ^UTILITY($J)

 S %ZIS="MQ" D ^%ZIS Q:POP  G:'$D(IO("Q")) DQ S ZTRTN="DQ^XTFCR" S %DT="FXTRAQE",%DT("A")="QUEUE to run WHEN:",%DT("B")="NOW" D ^%DT G:Y'>0 EXIT

 S X=+Y D H^%DTC S Y=Y_"0000",Y=%H_","_($E(Y,9,10)*60+$E(Y,11,12)*60) S ZTDTH=Y S ZTDESC="Flow Chart Routine",ZTSAVE("^TMP($J,")="",ZTSAVE("XTLEV")="",ZTIO=ION_";"_IOM_";"_IOSL

 D ^%ZTLOAD I $D(ZTSK) W !!,"TASK QUEUED",!

 G EXIT

 ;

DQ ; Entry point for tasked job

 S XTROU="@" F I=0:0 S XTROU=$O(^TMP($J,XTROU)) Q:XTROU=""  K ^(XTROU) S ^TMP($J,0,XTROU)=""

 S XT="",XTROU="@" F I=0:0 S XTROU=$O(^TMP($J,0,XTROU)) Q:XTROU=""  D ROU Q:XT=U

 D ^%ZISC K XTROU,XT

 G EXIT

 ;

ROU ;

 K ^TMP($J,XTLEV,"FC") W:IOST["C-" !,XTROU,! S XCNP=0,DIF="^TMP($J,0,"""_XTROU_""",",X=XTROU X ^%ZOSF("LOAD") K XCNP,DIF

 S XTIFLG=0,XTENTR=0,XTCOND=0 F I=0:0 S I=$O(^TMP($J,0,XTROU,I)) Q:I'>0  S X=^(I,0) D LINE^XTFC0

 U IO D ^XTFCR1 U 0

 K XTIFLG,XTENTR,XTCOND

 Q

 ;

EXIT ;

 K I,K,N,X,Y,Z,XTIJ,XTL1,XTL2,XTLEV,XTNAM,XTPCOND,XTTFLG,XTX1,XTX2,XTX2B,XTXCOND,XTZA,XTZX,XTZX1,^TMP($J),C

 Q

XTFCR     ;SF-ISC.SEA/JLI - FLOW CHART GENERATOR FOR MUMPS ROUTINES ;9/21/93  09:53 ;

 +1       ;;7.3;TOOLKIT;;Apr 25, 1995

 +2        WRITE !!,"FLOW CHART GENERATOR FOR MUMPS ROUTINES",!

 +3        WRITE !,"< COND >  = CONDITIONAL, if 'COND' is true code to the left is performed"

 +4        WRITE !!,"[ LINE^ROU ]   = DO or SUBROUTINE call to location LINE of routine ROU,",!,"                 control returns to commands following this in sequence"

 +5        WRITE !!,"{ LINE^ROU } = GO TO, control is transferred to the location LINE in",!,"               routine ROU.",!

ENTRY      SET XTLEV="A"

           KILL ^TMP($JOB),^UTILITY($JOB)

           XECUTE ^%ZOSF("RSEL")

           IF '($DATA(^UTILITY($JOB))\10)

               GOTO EXIT

 +1        SET %X="^UTILITY($J,"

           SET %Y="^TMP($J,"

           DO %XY^%RCR

           KILL ^UTILITY($JOB)

 +2        SET %ZIS="MQ"

           DO ^%ZIS

           IF POP

               QUIT 

           IF '$DATA(IO("Q"))

               GOTO DQ

           SET ZTRTN="DQ^XTFCR"

           SET %DT="FXTRAQE"

           SET %DT("A")="QUEUE to run WHEN:"

           SET %DT("B")="NOW"

           DO ^%DT

           IF Y'>0

               GOTO EXIT

 +3        SET X=+Y

           DO H^%DTC

           SET Y=Y_"0000"

           SET Y=%H_","_($EXTRACT(Y,9,10)*60+$EXTRACT(Y,11,12)*60)

           SET ZTDTH=Y

           SET ZTDESC="Flow Chart Routine"

           SET ZTSAVE("^TMP($J,")=""

           SET ZTSAVE("XTLEV")=""

           SET ZTIO=ION_";"_IOM_";"_IOSL

 +4        DO ^%ZTLOAD

           IF $DATA(ZTSK)

               WRITE !!,"TASK QUEUED",!

 +5        GOTO EXIT

 +6       ;

DQ        ; Entry point for tasked job

 +1        SET XTROU="@"

           FOR I=0:0

               SET XTROU=$ORDER(^TMP($JOB,XTROU))

               IF XTROU=""

                   QUIT 

               KILL ^(XTROU)

               SET ^TMP($JOB,0,XTROU)=""

 +2        SET XT=""

           SET XTROU="@"

           FOR I=0:0

               SET XTROU=$ORDER(^TMP($JOB,0,XTROU))

               IF XTROU=""

                   QUIT 

               DO ROU

               IF XT=U

                   QUIT 

 +3        DO ^%ZISC

           KILL XTROU,XT

 +4        GOTO EXIT

 +5       ;

ROU       ;

 +1        KILL ^TMP($JOB,XTLEV,"FC")

           IF IOST["C-"

               WRITE !,XTROU,!

           SET XCNP=0

           SET DIF="^TMP($J,0,"""_XTROU_""","

           SET X=XTROU

           XECUTE ^%ZOSF("LOAD")

           KILL XCNP,DIF

 +2        SET XTIFLG=0

           SET XTENTR=0

           SET XTCOND=0

           FOR I=0:0

               SET I=$ORDER(^TMP($JOB,0,XTROU,I))

               IF I'>0

                   QUIT 

               SET X=^(I,0)

               DO LINE^XTFC0

 +3        USE IO

           DO ^XTFCR1

           USE 0

 +4        KILL XTIFLG,XTENTR,XTCOND

 +5        QUIT 

 +6       ;

EXIT      ;

 +1        KILL I,K,N,X,Y,Z,XTIJ,XTL1,XTL2,XTLEV,XTNAM,XTPCOND,XTTFLG,XTX1,XTX2,XTX2B,XTXCOND,XTZA,XTZX,XTZX1,^TMP($JOB),C

 +2        QUIT