File:  [Coherent Logic Development] / freem_fileman / USER / DIRQ.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:21 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DIRQ	;SFISC/XAK-READER-MAID END ;7/11/94  14:34
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    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
    7: DA	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
   15: GQ	K %G
   16: Q	K %,%P,X,Y,DA(0) Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>