%RCR ;GFT/SF [ 04/02/90 1:25 PM ]
;;17.7;VA FileMan; 6/9/89
;IHS/MFD,IHS/THL ;3/28/90 ; rewrite of STORLIST and %XY
; with no use of ^UTILITY, uses local UT variable instead
;
STORLIST I $D(UT("%RCR",$J))[0 S UT("%RCR",$J)=0
S UT("%RCR",$J)=UT("%RCR",$J)+1,%D="%Z",%E="UT(""%RCR"",$J,"_UT("%RCR",$J)_",%D",%Y=%E_","
K UT("%RCR",$J,UT("%RCR",$J))
F S %D=$O(%RCR(%D)) Q:%D="" S:$D(@%D)#2 @(%E_")="_%D) I '($D(@%D)=1) S %X=%D_"(" D:$D(@%D)>9 %XY
CALL S %E=%RCR K %RCR,%X,%Y D @%E
S %E="UT(""%RCR"",$J,"_UT("%RCR",$J)_",%D",UT("%RCR",$J)=UT("%RCR",$J)-1,%D=0,%X=%E_","
F S %D=$O(@(%E_")")) Q:%D="" S:$D(UT("%RCR",$J,UT("%RCR",$J)+1,%D))#2 @%D=UT("%RCR",$J,UT("%RCR",$J)+1,%D) I '($D(UT("%RCR",$J,UT("%RCR",$J)+1,%D))=1) S %Y=%D_"(" D:$D(UT("%RCR",$J,UT("%RCR",$J)+1,%D))>9 %XY
K %D,%E,%X,%Y,UT("%RCR",$J,UT("%RCR",$J)+1) Q
%XY ;
;W "$" ;to see where and how much FM calls this entry point
N %A,%B D %A(%X) F S %B=$Q(@%B) Q:%B'[%A S @(%Y_$P(%B,%A,2,999)_"="_%B)
Q
%A(%C) ;Pass local or gl var, your var,%A & %B returned
;%A=var w/ other vars substituted ending w/ "," and no leading ^
;%B=var w/ other vars substituted ending w/ ")"
S %A="%C("_$P(%C,"(",2,99)_"1)",%B=$E(%A,1,$L(%A)-1)_",1)",@("("_%A_","_%B_")="""""),%A=$Q(@%A),%A=$P(%X,"(")_"("_$P($E(%A,1,$L(%A)-4),"(",2,99),%B=$S(%A[",":$E(%A,1,$L(%A)-1)_")",1:$P(%A,"(")),%A=$S($E(%A)="^":$E(%A,2,999),1:%A) Q
OS ;
S $P(^%ZOSF("OS"),"^",2)=DITZS
K ^%ZTSK(ZTSK),DITZS
Q
%RCR ;GFT/SF [ 04/02/90 1:25 PM ]
+1 ;;17.7;VA FileMan; 6/9/89
+2 ;IHS/MFD,IHS/THL ;3/28/90 ; rewrite of STORLIST and %XY
+3 ; with no use of ^UTILITY, uses local UT variable instead
+4 ;
STORLIST IF $DATA(UT("%RCR",$JOB))[0
SET UT("%RCR",$JOB)=0
+1 SET UT("%RCR",$JOB)=UT("%RCR",$JOB)+1
SET %D="%Z"
SET %E="UT(""%RCR"",$J,"_UT("%RCR",$JOB)_",%D"
SET %Y=%E_","
+2 KILL UT("%RCR",$JOB,UT("%RCR",$JOB))
+3 FOR
SET %D=$ORDER(%RCR(%D))
IF %D=""
QUIT
IF $DATA(@%D)#2
SET @(%E_")="_%D)
IF '($DATA(@%D)=1)
SET %X=%D_"("
IF $DATA(@%D)>9
DO %XY
CALL SET %E=%RCR
KILL %RCR,%X,%Y
DO @%E
+1 SET %E="UT(""%RCR"",$J,"_UT("%RCR",$JOB)_",%D"
SET UT("%RCR",$JOB)=UT("%RCR",$JOB)-1
SET %D=0
SET %X=%E_","
+2 FOR
SET %D=$ORDER(@(%E_")"))
IF %D=""
QUIT
IF $DATA(UT("%RCR",$JOB,UT("%RCR",$JOB)+1,%D))#2
SET @%D=UT("%RCR",$JOB,UT("%RCR",$JOB)+1,%D)
IF '($DATA(UT("%RCR",$JOB,UT("%RCR",$JOB)+1,%D))=1)
SET %Y=%D_"("
IF $DATA(UT("%RCR",$JOB,UT("%RCR",$JOB)+1,%D))>9
DO %XY
+3 KILL %D,%E,%X,%Y,UT("%RCR",$JOB,UT("%RCR",$JOB)+1)
QUIT
%XY ;
+1 ;W "$" ;to see where and how much FM calls this entry point
+2 NEW %A,%B
DO %A(%X)
FOR
SET %B=$QUERY(@%B)
IF %B'[%A
QUIT
SET @(%Y_$PIECE(%B,%A,2,999)_"="_%B)
+3 QUIT
%A(%C) ;Pass local or gl var, your var,%A & %B returned
+1 ;%A=var w/ other vars substituted ending w/ "," and no leading ^
+2 ;%B=var w/ other vars substituted ending w/ ")"
+3 SET %A="%C("_$PIECE(%C,"(",2,99)_"1)"
SET %B=$EXTRACT(%A,1,$LENGTH(%A)-1)_",1)"
SET @("("_%A_","_%B_")=""""")
SET %A=$QUERY(@%A)
SET %A=$PIECE(%X,"(")_"("_$PIECE($EXTRACT(%A,1,$LENGTH(%A)-4),"(",2,99)
SET %B=$SELECT(%A[",":$EXTRACT(%A,1,$LENGTH(%A)-1)_")",1:$PIECE(%A,"("))
SET %A=$SELECT($EXTRACT(%A)="^":$EXTRACT(%A,2,999),1:%A)
QUIT
OS ;
+1 SET $PIECE(^%ZOSF("OS"),"^",2)=DITZS
+2 KILL ^%ZTSK(ZTSK),DITZS
+3 QUIT