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
