- DIQGDD0 ;SFISC/DCL-NODE PIECE LOOKUP FOR DD ;09:26 AM 5 Jan 1994
- ;;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.
- ;
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIQGDD0 2106 printed Mar 13, 2025@21:58:27 Page 2
- DIQGDD0 ;SFISC/DCL-NODE PIECE LOOKUP FOR DD ;09:26 AM 5 Jan 1994
- +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 ;
- 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
