source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIRQ.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 704 bytes
RevLine 
[613]1DIRQ ;SFISC/XAK-READER-MAID END ;7/11/94 14:34
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 K:$D(%G) DIR("B")
5 K DIR0("L")
6 Q
7DA I DA'=+$P(DA,"E") K DA Q
8 S (X,Y)=%B1,DA(0)=DA
9 F %=0:1 Q:'$D(^DD(X,0,"UP")) S X=^("UP"),%P=$O(^DD(X,"SB",Y,0)),%(%)=""""_$P($P(^DD(X,%P,0),U,4),";")_""",",Y=X
10 S %(%)=$S($D(^DIC(X,0,"GL")):^("GL"),1:"") G Q:%(%)=""
11 S %G="" F %=%:-1:0 G GQ:'$D(DA(%)) S %G=%G_%(%)_DA(%)_","
12 S %P=$P(%B3,U,4),%=$P(%P,";"),%G=%G_""""_%_""")" G GQ:'$D(@%G)
13 S %G=$P(%P,";",2),Y=$S(%G:$P(^(%),U,%G),1:$E(^(%),+$P(%G,"E",2),$P(%G,",",2))) G GQ:Y=""
14 S %G=Y,C=$P(^DD(%B1,%B2,0),U,2) D Y^DIQ S DIR("B")=Y G Q
15GQ K %G
16Q K %,%P,X,Y,DA(0) Q
Note: See TracBrowser for help on using the repository browser.