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