- XTFCR1 ;SF-ISC.SEA/JLI - DISPLAY FLOWCHART ;9/21/93 09:58 ;
- ;;7.3;TOOLKIT;;Apr 25, 1995
- W @IOF
- K LN S XT="",XTZX1="" F Z=0:0 S Z=$O(^TMP($J,XTLEV,"FC",Z)) Q:Z'>0 S XTZX=$O(^TMP($J,XTLEV,"FC",Z,"")) D LIST Q:XT=U
- I XT'=U D WAIT
- Q
- ;
- LIST ;
- S N=$S(IOM<80:80,1:IOM)\2+20,X=^TMP($J,XTLEV,"FC",Z,XTZX) S:'$D(LN) LN=N F XTZA=0:0 S Y=$E(X,1,4) Q:Y'=" "&(Y'="....") S X=$E(X,5,$L(X)),N=N-10 S:N<1 N=1
- D:N>LN CLOSE K NX S NX=$S(N>1:N,1:0) F NX=NX:10:($S(IOM<80:80,1:IOM)\2+20) S:'$D(NX(NX+10)) NX(NX)="" S:NX<($S(IOM<80:80,1:IOM)\2+20) NX(NX+20)=""
- I XTZX1'="PROC "!(XTZX'="PROC ") W ! I LN'=N!(XTZX1'="GOTO "&(XTZX1'="QUIT ")) F NX=-1:0 S NX=$O(NX(NX)) Q:NX="" W ?NX,"|"
- S LN=N,N=$S(XTZX="LABEL":N-$L(X),1:N-($L(X)\2))
- D:$Y+3>IOSL WAIT Q:XT=U W !,?N,X S XTZX1=XTZX
- F NX=0:0 S NX=$O(NX(NX)) Q:NX="" I NX>($X+1) W ?NX,"|"
- Q
- ;
- WAIT ; Skip to top of next page
- I IOST["C-" F K=1:1:4 Q:$Y+3'<IOSL W !
- I 1 S XT="" R:IOST["C-" !?26,"Press RETURN to continue, '^' to halt...",XT:DTIME S:'$T XT=U W @IOF
- Q
- CLOSE ; Close previous nesting level
- S IX1=$S(LN>1:LN,1:0),IX2=IX1+19 S:XTZX1="GOTO "!(XTZX1="QUIT ") IX1=IX1+10 W ! W:IX1'>LN ?IX1,"|" W:IX1>LN ?IX1 F IX3=0:0 Q:($X'<(IX2+1)) W "_"
- W "|" F NX=-1:0 S NX=$O(NX(NX)) Q:NX="" I $X<(NX-1) W ?NX,"|"
- S LN=$S(LN>1:LN,1:0)+10 I LN<N S XTZX1=" " G CLOSE
- S LN=LN-1 Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTFCR1 1352 printed Feb 19, 2025@00:07:26 Page 2
- XTFCR1 ;SF-ISC.SEA/JLI - DISPLAY FLOWCHART ;9/21/93 09:58 ;
- +1 ;;7.3;TOOLKIT;;Apr 25, 1995
- +2 WRITE @IOF
- +3 KILL LN
- SET XT=""
- SET XTZX1=""
- FOR Z=0:0
- SET Z=$ORDER(^TMP($JOB,XTLEV,"FC",Z))
- if Z'>0
- QUIT
- SET XTZX=$ORDER(^TMP($JOB,XTLEV,"FC",Z,""))
- DO LIST
- if XT=U
- QUIT
- +4 IF XT'=U
- DO WAIT
- +5 QUIT
- +6 ;
- LIST ;
- +1 SET N=$SELECT(IOM<80:80,1:IOM)\2+20
- SET X=^TMP($JOB,XTLEV,"FC",Z,XTZX)
- if '$DATA(LN)
- SET LN=N
- FOR XTZA=0:0
- SET Y=$EXTRACT(X,1,4)
- if Y'=" "&(Y'="....")
- QUIT
- SET X=$EXTRACT(X,5,$LENGTH(X))
- SET N=N-10
- if N<1
- SET N=1
- +2 if N>LN
- DO CLOSE
- KILL NX
- SET NX=$SELECT(N>1:N,1:0)
- FOR NX=NX:10:($SELECT(IOM<80:80,1:IOM)\2+20)
- if '$DATA(NX(NX+10))
- SET NX(NX)=""
- if NX<($SELECT(IOM<80
- SET NX(NX+20)=""
- +3 IF XTZX1'="PROC "!(XTZX'="PROC ")
- WRITE !
- IF LN'=N!(XTZX1'="GOTO "&(XTZX1'="QUIT "))
- FOR NX=-1:0
- SET NX=$ORDER(NX(NX))
- if NX=""
- QUIT
- WRITE ?NX,"|"
- +4 SET LN=N
- SET N=$SELECT(XTZX="LABEL":N-$LENGTH(X),1:N-($LENGTH(X)\2))
- +5 if $Y+3>IOSL
- DO WAIT
- if XT=U
- QUIT
- WRITE !,?N,X
- SET XTZX1=XTZX
- +6 FOR NX=0:0
- SET NX=$ORDER(NX(NX))
- if NX=""
- QUIT
- IF NX>($X+1)
- WRITE ?NX,"|"
- +7 QUIT
- +8 ;
- WAIT ; Skip to top of next page
- +1 IF IOST["C-"
- FOR K=1:1:4
- if $Y+3'<IOSL
- QUIT
- WRITE !
- +2 IF 1
- SET XT=""
- if IOST["C-"
- READ !?26,"Press RETURN to continue, '^' to halt...",XT:DTIME
- if '$TEST
- SET XT=U
- WRITE @IOF
- +3 QUIT
- CLOSE ; Close previous nesting level
- +1 SET IX1=$SELECT(LN>1:LN,1:0)
- SET IX2=IX1+19
- if XTZX1="GOTO "!(XTZX1="QUIT ")
- SET IX1=IX1+10
- WRITE !
- if IX1'>LN
- WRITE ?IX1,"|"
- if IX1>LN
- WRITE ?IX1
- FOR IX3=0:0
- if ($X'<(IX2+1))
- QUIT
- WRITE "_"
- +2 WRITE "|"
- FOR NX=-1:0
- SET NX=$ORDER(NX(NX))
- if NX=""
- QUIT
- IF $X<(NX-1)
- WRITE ?NX,"|"
- +3 SET LN=$SELECT(LN>1:LN,1:0)+10
- IF LN<N
- SET XTZX1=" "
- GOTO CLOSE
- +4 SET LN=LN-1
- QUIT