Return to DIQGU0.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIQGU0.m, revision 1.1

1.1     ! snw         1: DIQGU0 ;SFISC/DCL-DATA RETRIVIAL UTILITY PROGRAM ;02:42 PM  24 Aug 1993;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: R(%R)  ;
        !             5:        N %C,%F,%G,%I,%R1,%R2
        !             6:        S %R1=$P(%R,"(")_"(" I $E(%R1)="^" S %R2=$P($Q(@(%R1_""""")")),"(")_"(" S:$P(%R2,"(")]"" %R1=%R2
        !             7:        S %R2=$P($E(%R,1,($L(%R)-($E(%R,$L(%R))=")"))),"(",2,99)
        !             8:        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
        !             9:        Q %R1_%R2
        !            10: S(%Z)  ;
        !            11:        I $G(%Z)']"" Q ""
        !            12:        I $E(%Z)'="""",$L(%Z,"E")=2,+$P(%Z,"E")=$P(%Z,"E"),+$P(%Z,"E",2)=$P(%Z,"E",2) Q +%Z
        !            13:        I +%Z=%Z Q %Z
        !            14:        I %Z="""""" Q ""
        !            15:        I $E(%Z)'?1A,"%$+@"'[$E(%Z) Q %Z
        !            16:        I "+$"[$E(%Z) X "S %Z="_%Z Q $$Q(%Z)
        !            17:        I $D(@%Z) Q $$Q(@%Z)
        !            18:        Q %Z
        !            19: Q(%Z)  ;
        !            20:        S %Z(%Z)="",%Z=$Q(%Z("")) Q $E(%Z,4,$L(%Z)-1)
        !            21: DDLST(DDN,ATRN,FL)     ;
        !            22:        N X,Y S:$D(^DD(DDN)) ATRN(DDN)="" S FL=+$G(FL)
        !            23:        D  S X=0 F  S X=$O(^DD(DDN,"SB",X)) Q:X'>0  S ATRN(X)="" D  D DDLST(X,.ATRN,FL)
        !            24:        .I 'FL S Y="" F  S Y=$O(^DD(DDN,"B",Y)) Q:Y=""  S ATRN(Y,DDN)=$O(^(Y,""))
        !            25:        .Q
        !            26:        Q
        !            27: DDN(ATN,F)     ;
        !            28:        N DNA,DDN,X,Y S X="$$$ NO SUCH ATTRIBUTE $$$"
        !            29:        Q:$G(ATN)']"" X
        !            30:        D DDLST(+$G(F),.DNA,1)
        !            31:        S DDN="" F  S DDN=$O(DNA(DDN)) Q:DDN=""  D  Q:X
        !            32:        .S Y="" F  S Y=$O(^DD(DDN,"B",Y)) Q:Y=""  I Y=ATN S X=DDN_"^"_$O(^DD(DDN,"B",Y,"")) Q
        !            33:        .Q
        !            34:        I '$G(F),$E(X,1,6)="$$$ NO" Q $$DDN(ATN,1)
        !            35:        Q X
        !            36: DDLST2(DDN,ATRN,FL)    ;
        !            37:        N X,Y S:$D(^DD(DDN)) ATRN(DDN)="" S FL='$D(FL)
        !            38:        S X=0 F  S X=$O(^DD(DDN,"SB",X)) Q:X'>0  D
        !            39:        .I FL S ATRN(X)="",Y=0 F  S Y=$O(^DD(DDN,Y)) Q:Y'>0  S ATRN(Y,DDN)=$P($G(^(Y,0)),"^")
        !            40:        .D DDLST2(X,.ATRN)
        !            41:        .Q
        !            42:        Q