ORWUX ; SLC/KCM - Development Utilities
;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
SYMTAB(REF) ; Return the current symbol table
N X K ^TMP($J,"SAV"),^TMP($J,"SND")
S X="^TMP($J,""SAV""," D DOLRO^%ZOSV
N N,I,L S X="^TMP($J,""SAV"")",L=0
S L=L+1,^TMP($J,"SND",L)="$I="_$I_" $J="_$J_" $S="_$S
S L=L+1,^TMP($J,"SND",L)="" ;must send two lines per entry
F S X=$Q(@X) Q:$QL(X)<3 Q:$QS(X,1)'=$J Q:$QS(X,2)'="SAV" D
. S N=$QS(X,3)
. I $QL(X)=3 D Q
. . S L=L+1,^TMP($J,"SND",L)=N
. . S L=L+1,^TMP($J,"SND",L)=@X
. E D
. . S N=N_"(" F I=4:1:$QL(X) S N=N_$QS(X,I)_","
. . S N=$E(N,1,$L(N)-1)_")"
. . S L=L+1,^TMP($J,"SND",L)=N
. . S L=L+1,^TMP($J,"SND",L)=@X
S REF=$NA(^TMP($J,"SND"))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWUX 731 printed Nov 22, 2024@17:47:45 Page 2
ORWUX ; SLC/KCM - Development Utilities
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
SYMTAB(REF) ; Return the current symbol table
+1 NEW X
KILL ^TMP($JOB,"SAV"),^TMP($JOB,"SND")
+2 SET X="^TMP($J,""SAV"","
DO DOLRO^%ZOSV
+3 NEW N,I,L
SET X="^TMP($J,""SAV"")"
SET L=0
+4 SET L=L+1
SET ^TMP($JOB,"SND",L)="$I="_$IO_" $J="_$JOB_" $S="_$STORAGE
+5 ;must send two lines per entry
SET L=L+1
SET ^TMP($JOB,"SND",L)=""
+6 FOR
SET X=$QUERY(@X)
if $QLENGTH(X)<3
QUIT
if $QSUBSCRIPT(X,1)'=$JOB
QUIT
if $QSUBSCRIPT(X,2)'="SAV"
QUIT
Begin DoDot:1
+7 SET N=$QSUBSCRIPT(X,3)
+8 IF $QLENGTH(X)=3
Begin DoDot:2
+9 SET L=L+1
SET ^TMP($JOB,"SND",L)=N
+10 SET L=L+1
SET ^TMP($JOB,"SND",L)=@X
End DoDot:2
QUIT
+11 IF '$TEST
Begin DoDot:2
+12 SET N=N_"("
FOR I=4:1:$QLENGTH(X)
SET N=N_$QSUBSCRIPT(X,I)_","
+13 SET N=$EXTRACT(N,1,$LENGTH(N)-1)_")"
+14 SET L=L+1
SET ^TMP($JOB,"SND",L)=N
+15 SET L=L+1
SET ^TMP($JOB,"SND",L)=@X
End DoDot:2
End DoDot:1
+16 SET REF=$NAME(^TMP($JOB,"SND"))
+17 QUIT
