| [613] | 1 | DIQGU0 ;SFISC/DCL-DATA RETRIVIAL UTILITY PROGRAM ;02:42 PM 24 Aug 1993
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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
|
|---|
