AZHYRCRG.m

%RCR ;GFT/SF [ 04/02/90  1:24 PM ]

 ;;17.7;VA FileMan; 6/9/89

 ;IHS/MFD,IHS/THL ;3/28/90; rewrite of STORLIST and %XY

 ; still using the ^UTILITY global

 ;

STORLIST I $D(^UTILITY("%RCR",$J))[0 S ^UTILITY("%RCR",$J)=0

 S ^($J)=^($J)+1,%D="%Z",%E="^UTILITY(""%RCR"",$J,"_^($J)_",%D",%Y=%E_","

 K ^($J,^($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="^UTILITY(""%RCR"",$J,"_^UTILITY("%RCR",$J)_",%D",^($J)=^($J)-1,%D=0,%X=%E_","

 F  S %D=$O(@(%E_")")) Q:%D=""  S:$D(^(%D))#2 @%D=^(%D) I '($D(^(%D))=1) S %Y=%D_"(" D:$D(^(%D))>9 %XY

 K %D,%E,%X,%Y,^($J,^UTILITY("%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:24 PM ]

 +1       ;;17.7;VA FileMan; 6/9/89

 +2       ;IHS/MFD,IHS/THL ;3/28/90; rewrite of STORLIST and %XY

 +3       ; still using the ^UTILITY global

 +4       ;

STORLIST   IF $DATA(^UTILITY("%RCR",$JOB))[0

               SET ^UTILITY("%RCR",$JOB)=0

 +1        SET ^($JOB)=^($JOB)+1

           SET %D="%Z"

           SET %E="^UTILITY(""%RCR"",$J,"_^($JOB)_",%D"

           SET %Y=%E_","

 +2        KILL ^($JOB,^($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="^UTILITY(""%RCR"",$J,"_^UTILITY("%RCR",$JOB)_",%D"

           SET ^($JOB)=^($JOB)-1

           SET %D=0

           SET %X=%E_","

 +2        FOR 

               SET %D=$ORDER(@(%E_")"))

               IF %D=""

                   QUIT 

               IF $DATA(^(%D))#2

                   SET @%D=^(%D)

               IF '($DATA(^(%D))=1)

                   SET %Y=%D_"("

                   IF $DATA(^(%D))>9

                       DO %XY

 +3        KILL %D,%E,%X,%Y,^($JOB,^UTILITY("%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