Return to %RCR.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/%RCR.m, revision 1.1

1.1     ! snw         1: DIRCR  ;SFISC/GFT-DELETE THIS LINE AND SAVE AS '%RCR'*** ;12:18 PM  20 Apr 1993
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: %RCR   ;GFT/SF
        !             5:        ;
        !             6: STORLIST       ;
        !             7:        D INIT
        !             8: O      S %D=$O(%RCR(%D)) G CALL:%D=""
        !             9:        I $D(@%D)#2 S @(%E_")="_%D) G O:$D(@%D)=1
        !            10:        S %X=%D_"(" D %XY G O
        !            11:        ;
        !            12: CALL   S %E=%RCR K %RCR,%X,%Y D @%E
        !            13:        S %E="^UTILITY(""%RCR"",$J,"_^UTILITY("%RCR",$J)_",%D",^($J)=^($J)-1,%D=0,%X=%E_","
        !            14: G      S %D=$O(@(%E_")")) I %D="" K %D,%E,%X,%Y,^($J,^UTILITY("%RCR",$J)+1) Q
        !            15:        I $D(^(%D))#2 S @%D=^(%D) G G:$D(^(%D))=1
        !            16:        S %Y=%D_"(" D %XY G G
        !            17:        ;
        !            18:        ;
        !            19: XY(%X,%Y)      ;
        !            20: %XY    ;
        !            21:        N %A,%B,%Q,%Z
        !            22:        S %A=$$R(%X),%Q=""""""
        !            23:        I $P(%A,"(",2)]"",$E(%A,$L(%A))'="," S:$L($P(%A,"(",2),",")>1 %Q=$P(%A,",",$L(%A,",")),$P(%A,",",$L(%A,","))="" S:%Q="""""" %Q=$P(%A,"(",2),$P(%A,"(",2)=""
        !            24:        S %Z=%A_%Q_")",%B=$L(%A)+1
        !            25:        F  S %Z=$Q(@%Z) Q:$P(%Z,%A)]""!(%Z="")  S @(%Y_$E(%Z,%B,255))=@%Z
        !            26:        Q
        !            27: R(%R)  ;
        !            28:        N %C,%F,%G,%I,%R1,%R2
        !            29:        S %R1=$P(%R,"(")_"(" I $E(%R1)="^" S %R2=$P($Q(@(%R1_""""")")),"(")_"(" S:$P(%R2,"(")]"" %R1=%R2
        !            30:        S %R2=$P($E(%R,1,($L(%R)-($E(%R,$L(%R))=")"))),"(",2,99)
        !            31:        S %C=$L(%R2,","),%F=1 F %I=1:1:%C S %G=$P(%R2,",",%F,%I) Q:%G=""  I ($L(%G,"(")=$L(%G,")")&($L(%G,"""")#2))!(($L(%G,"""")#2)&($E(%G)="""")&($E(%G,$L(%G))="""")) S %G=$$S(%G),$P(%R2,",",%F,%I)=%G,%F=%F+$L(%G,","),%I=%F-1
        !            32:        Q %R1_%R2
        !            33: S(%Z)  ;
        !            34:        I $G(%Z)']"" Q ""
        !            35:        I $E(%Z)'="""",$L(%Z,"E")=2,+$P(%Z,"E")=$P(%Z,"E"),+$P(%Z,"E",2)=$P(%Z,"E",2) Q +%Z
        !            36:        I +%Z=%Z Q %Z
        !            37:        I %Z="""""" Q ""
        !            38:        I $E(%Z)'?1A,"%$+@"'[$E(%Z) Q %Z
        !            39:        I "+$"[$E(%Z) X "S %Z="_%Z Q $$Q(%Z)
        !            40:        I $D(@%Z) Q $$Q(@%Z)
        !            41:        Q %Z
        !            42: Q(%Z)  ;
        !            43:        S %Z(%Z)="",%Z=$Q(%Z("")) Q $E(%Z,4,$L(%Z)-1)
        !            44:        ;
        !            45: INIT   I $D(^UTILITY("%RCR",$J))[0 S ^UTILITY("%RCR",$J)=0
        !            46:        S ^($J)=^($J)+1,%D="%Z",%E="^UTILITY(""%RCR"",$J,"_^($J)_",%D",%Y=%E_","
        !            47:        K ^($J,^($J))
        !            48:        Q
        !            49: OS     ;
        !            50:        S $P(^%ZOSF("OS"),"^",2)=DITZS
        !            51:        K DITZS S ZTREQ="@"
        !            52:        Q