DIRQ.m

DIRQ ;SFISC/XAK-READER-MAID END ;7/11/94  14:34

 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 ;;Per VA Directive 6402, this routine should not be modified.

 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 ;;Licensed under the terms of the Apache License, Version 2.0.

 ;

 K:$D(%G) DIR("B")

 K DIR0("L")

 Q

DA I DA'=+$P(DA,"E") K DA Q

 S (X,Y)=%B1,DA(0)=DA

 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

 S %(%)=$S($D(^DIC(X,0,"GL")):^("GL"),1:"") G Q:%(%)=""

 S %G="" F %=%:-1:0 G GQ:'$D(DA(%)) S %G=%G_%(%)_DA(%)_","

 S %P=$P(%B3,U,4),%=$P(%P,";"),%G=%G_""""_%_""")" G GQ:'$D(@%G)

 S %G=$P(%P,";",2),Y=$S(%G:$P(^(%),U,%G),1:$E(^(%),+$P(%G,"E",2),$P(%G,",",2))) G GQ:Y=""

 S %G=Y,C=$P(^DD(%B1,%B2,0),U,2) D Y^DIQ S DIR("B")=Y G Q

GQ K %G

Q K %,%P,X,Y,DA(0) Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DIRQ   927     printed  Apr 09, 2024@21:47:11                                                                                                                                                                                                         Page 2

DIRQ      ;SFISC/XAK-READER-MAID END ;7/11/94  14:34

 +1       ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 +4       ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 +5       ;;Licensed under the terms of the Apache License, Version 2.0.

 +6       ;

 +7        if $DATA(%G)

               KILL DIR("B")

 +8        KILL DIR0("L")

 +9        QUIT 

DA         IF DA'=+$PIECE(DA,"E")

               KILL DA

               QUIT 

 +1        SET (X,Y)=%B1

           SET DA(0)=DA

 +2        FOR %=0:1

               if '$DATA(^DD(X,0,"UP"))

                   QUIT 

               SET X=^("UP")

               SET %P=$ORDER(^DD(X,"SB",Y,0))

               SET %(%)=""""_$PIECE($PIECE(^DD(X,%P,0),U,4),";")_""","

               SET Y=X

 +3        SET %(%)=$SELECT($DATA(^DIC(X,0,"GL")):^("GL"),1:"")

           if %(%)=""

               GOTO Q

 +4        SET %G=""

           FOR %=%:-1:0

               if '$DATA(DA(%))

                   GOTO GQ

               SET %G=%G_%(%)_DA(%)_","

 +5        SET %P=$PIECE(%B3,U,4)

           SET %=$PIECE(%P,";")

           SET %G=%G_""""_%_""")"

           if '$DATA(@%G)

               GOTO GQ

 +6        SET %G=$PIECE(%P,";",2)

           SET Y=$SELECT(%G:$PIECE(^(%),U,%G),1:$EXTRACT(^(%),+$PIECE(%G,"E",2),$PIECE(%G,",",2)))

           if Y=""

               GOTO GQ

 +7        SET %G=Y

           SET C=$PIECE(^DD(%B1,%B2,0),U,2)

           DO Y^DIQ

           SET DIR("B")=Y

           GOTO Q

GQ         KILL %G

Q          KILL %,%P,X,Y,DA(0)

           QUIT