DIQGDD0.m

DIQGDD0 ;SFISC/DCL-NODE PIECE LOOKUP FOR DD ;09:26 AM  5 Jan 1994

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

NPS(DIQGDDN,DIQGNP) ;(CLOSEREFERENCE,PIECE)

 ;NODE PIECE SEARCH - DIQGDDN IS DD NUMBER - DIQGNP IS PIECE

 ; * * RETURNS FIELD NUMBER * *

 Q:$G(DIQGDDN)'>0 "" Q:$G(DIQGNP)="" ""

 N DIQGDDRT,DIQGDDRO,DIQGDDRN,DIQGFLD

 S DIQGDDRT="^DD("_DIQGDDN_")"

 S DIQGDDRO=0,DIQGFLD=""

 F  S DIQGDDRO=$O(@DIQGDDRT@(DIQGDDRO)) Q:DIQGDDRO'>0  D  Q:DIQGFLD

 .Q:'$D(@DIQGDDRT@(DIQGDDRO,0))  S DIQGDDRN=$P(^(0),"^",4)

 .I DIQGNP=DIQGDDRN S DIQGFLD=DIQGDDRO Q

 .I $P(DIQGDDRN,";")'?.N S $P(DIQGDDRN,";")=$$Q($P(DIQGDDRN,";")) I DIQGNP=DIQGDDRN S DIQGFLD=DIQGDDRO Q

 .I $P(DIQGDDRN,";")=$P(DIQGNP,";"),$E($P(DIQGDDRN,";",2))="E" S DIQGFLD=DIQGDDRO Q

 .Q

 Q DIQGFLD

 ;

Q(%Z) ;(PLACE QUOATES AROUND %Z)

 S %Z(%Z)="",%Z=$Q(%Z("")) Q $E(%Z,4,$L(%Z)-1)

 ;

FN(DIQGROOT) ;(CLOSEDREFERENCE)

 ; * * RETURNS FILE NUMBER * *

 ;CONVERT ROOT TO FILE NUMBER

 Q:$L($G(DIQGROOT),",")'>1 ""

 Q:$E(DIQGROOT,$L(DIQGROOT))'=")" ""

 N I,L,T,X,Y

 S X=DIQGROOT,L=$L(X),T=""

 F I=L:-1 S Y=$E(X,I) S:Y=","!(Y="(") T=T=0 Q:Y=""  I T,((Y=",")!(Y="(")) Q

 I I,$D(@($E(X,1,I)_"0)")) Q +$P(^(0),"^",2)

 Q ""

 ;

NP(ROOT,PIECE) ;CONVERT ROOT AND PIECE TO NODE;PIECE

 ; * * RETURNS 'NODE;PIECE' * *

 Q:$G(ROOT)="" "" Q:$G(PIECE)="" ""

 Q $P($P(ROOT,",",$L(ROOT,",")),")")_";"_PIECE

 ;

PIECE(DIQGR,DA,DR,DIQGPARM,DIQGTA,DIQGERRA,DIQGIPAR) ;CLOSEDREF,PIECE,ATTRIBUTE,FLAG,TARGETARRAY,ERRORARRAY,INTERNAL

EN6 ;PROCEDURE CALL AND  * * RETURN RESULTS IN TARGET ARRAY * *

 I $G(U)'="^" N U S U="^"

 N DIQGNP S DIQGR=$G(DIQGR),DA=$G(DA)

 S DIQGNP=$$NP(DIQGR,DA) I DIQGNP="" G 200

 S DIQGR=$$FN(DIQGR) I DIQGR="" G 200

 S DA=$$NPS(DIQGR,DIQGNP) I DA'>0 G 200

 G EN1^DIQGDD

 ;

200 D BLD^DIALOG(200)

 I $G(DIQGERRA)]"" D CALLOUT^DIEFU(DIQGERRA)

 Q

DIQGDD0   ;SFISC/DCL-NODE PIECE LOOKUP FOR DD ;09:26 AM  5 Jan 1994

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

NPS(DIQGDDN,DIQGNP) ;(CLOSEREFERENCE,PIECE)

 +1       ;NODE PIECE SEARCH - DIQGDDN IS DD NUMBER - DIQGNP IS PIECE

 +2       ; * * RETURNS FIELD NUMBER * *

 +3        IF $GET(DIQGDDN)'>0

               QUIT ""

           IF $GET(DIQGNP)=""

               QUIT ""

 +4        NEW DIQGDDRT,DIQGDDRO,DIQGDDRN,DIQGFLD

 +5        SET DIQGDDRT="^DD("_DIQGDDN_")"

 +6        SET DIQGDDRO=0

           SET DIQGFLD=""

 +7        FOR 

               SET DIQGDDRO=$ORDER(@DIQGDDRT@(DIQGDDRO))

               IF DIQGDDRO'>0

                   QUIT 

               Begin DoDot:1

 +8                IF '$DATA(@DIQGDDRT@(DIQGDDRO,0))

                       QUIT 

                   SET DIQGDDRN=$PIECE(^(0),"^",4)

 +9                IF DIQGNP=DIQGDDRN

                       SET DIQGFLD=DIQGDDRO

                       QUIT 

 +10               IF $PIECE(DIQGDDRN,";")'?.N

                       SET $PIECE(DIQGDDRN,";")=$$Q($PIECE(DIQGDDRN,";"))

                       IF DIQGNP=DIQGDDRN

                           SET DIQGFLD=DIQGDDRO

                           QUIT 

 +11               IF $PIECE(DIQGDDRN,";")=$PIECE(DIQGNP,";")

                       IF $EXTRACT($PIECE(DIQGDDRN,";",2))="E"

                           SET DIQGFLD=DIQGDDRO

                           QUIT 

 +12               QUIT 

               End DoDot:1

               IF DIQGFLD

                   QUIT 

 +13       QUIT DIQGFLD

 +14      ;

Q(%Z)     ;(PLACE QUOATES AROUND %Z)

 +1        SET %Z(%Z)=""

           SET %Z=$QUERY(%Z(""))

           QUIT $EXTRACT(%Z,4,$LENGTH(%Z)-1)

 +2       ;

FN(DIQGROOT) ;(CLOSEDREFERENCE)

 +1       ; * * RETURNS FILE NUMBER * *

 +2       ;CONVERT ROOT TO FILE NUMBER

 +3        IF $LENGTH($GET(DIQGROOT),",")'>1

               QUIT ""

 +4        IF $EXTRACT(DIQGROOT,$LENGTH(DIQGROOT))'=")"

               QUIT ""

 +5        NEW I,L,T,X,Y

 +6        SET X=DIQGROOT

           SET L=$LENGTH(X)

           SET T=""

 +7        FOR I=L:-1

               SET Y=$EXTRACT(X,I)

               IF Y=","!(Y="(")

                   SET T=T=0

               IF Y=""

                   QUIT 

               IF T

                   IF ((Y=",")!(Y="("))

                       QUIT 

 +8        IF I

               IF $DATA(@($EXTRACT(X,1,I)_"0)"))

                   QUIT +$PIECE(^(0),"^",2)

 +9        QUIT ""

 +10      ;

NP(ROOT,PIECE) ;CONVERT ROOT AND PIECE TO NODE;PIECE

 +1       ; * * RETURNS 'NODE;PIECE' * *

 +2        IF $GET(ROOT)=""

               QUIT ""

           IF $GET(PIECE)=""

               QUIT ""

 +3        QUIT $PIECE($PIECE(ROOT,",",$LENGTH(ROOT,",")),")")_";"_PIECE

 +4       ;

PIECE(DIQGR,DA,DR,DIQGPARM,DIQGTA,DIQGERRA,DIQGIPAR) ;CLOSEDREF,PIECE,ATTRIBUTE,FLAG,TARGETARRAY,ERRORARRAY,INTERNAL

EN6       ;PROCEDURE CALL AND  * * RETURN RESULTS IN TARGET ARRAY * *

 +1        IF $GET(U)'="^"

               NEW U

               SET U="^"

 +2        NEW DIQGNP

           SET DIQGR=$GET(DIQGR)

           SET DA=$GET(DA)

 +3        SET DIQGNP=$$NP(DIQGR,DA)

           IF DIQGNP=""

               GOTO 200

 +4        SET DIQGR=$$FN(DIQGR)

           IF DIQGR=""

               GOTO 200

 +5        SET DA=$$NPS(DIQGR,DIQGNP)

           IF DA'>0

               GOTO 200

 +6        GOTO EN1^DIQGDD

 +7       ;

200        DO BLD^DIALOG(200)

 +1        IF $GET(DIQGERRA)]""

               DO CALLOUT^DIEFU(DIQGERRA)

 +2        QUIT