| 1 | DIRCR ;SFISC/GFT-DELETE THIS LINE AND SAVE AS '%RCR'*** ;12:18 PM 20 Apr 1993
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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
|
|---|
