Return to DIQGDD0.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIQGDD0	;DCL/SFISC-NODE PIECE LOOKUP FOR DD;09:26 AM  5 Jan 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: NPS(DIQGDDN,DIQGNP)	;(CLOSEREFERENCE,PIECE)
    5: 	;NODE PIECE SEARCH - DIQGDDN IS DD NUMBER - DIQGNP IS PIECE
    6: 	; * * RETURNS FIELD NUMBER * *
    7: 	Q:$G(DIQGDDN)'>0 "" Q:$G(DIQGNP)="" ""
    8: 	N DIQGDDRT,DIQGDDRO,DIQGDDRN,DIQGFLD
    9: 	S DIQGDDRT="^DD("_DIQGDDN_")"
   10: 	S DIQGDDRO=0,DIQGFLD=""
   11: 	F  S DIQGDDRO=$O(@DIQGDDRT@(DIQGDDRO)) Q:DIQGDDRO'>0  D  Q:DIQGFLD
   12: 	.Q:'$D(@DIQGDDRT@(DIQGDDRO,0))  S DIQGDDRN=$P(^(0),"^",4)
   13: 	.I DIQGNP=DIQGDDRN S DIQGFLD=DIQGDDRO Q
   14: 	.I $P(DIQGDDRN,";")'?.N S $P(DIQGDDRN,";")=$$Q($P(DIQGDDRN,";")) I DIQGNP=DIQGDDRN S DIQGFLD=DIQGDDRO Q
   15: 	.I $P(DIQGDDRN,";")=$P(DIQGNP,";"),$E($P(DIQGDDRN,";",2))="E" S DIQGFLD=DIQGDDRO Q
   16: 	.Q
   17: 	Q DIQGFLD
   18: 	;
   19: Q(%Z)	;(PLACE QUOATES AROUND %Z)
   20: 	S %Z(%Z)="",%Z=$Q(%Z("")) Q $E(%Z,4,$L(%Z)-1)
   21: 	;
   22: FN(DIQGROOT)	;(CLOSEDREFERENCE)
   23: 	; * * RETURNS FILE NUMBER * *
   24: 	;CONVERT ROOT TO FILE NUMBER
   25: 	Q:$L($G(DIQGROOT),",")'>1 ""
   26: 	Q:$E(DIQGROOT,$L(DIQGROOT))'=")" ""
   27: 	N I,L,T,X,Y
   28: 	S X=DIQGROOT,L=$L(X),T=""
   29: 	F I=L:-1 S Y=$E(X,I) S:Y=","!(Y="(") T=T=0 Q:Y=""  I T,((Y=",")!(Y="(")) Q
   30: 	I I,$D(@($E(X,1,I)_"0)")) Q +$P(^(0),"^",2)
   31: 	Q ""
   32: 	;
   33: NP(ROOT,PIECE)	;CONVERT ROOT AND PIECE TO NODE;PIECE
   34: 	; * * RETURNS 'NODE;PIECE' * *
   35: 	Q:$G(ROOT)="" "" Q:$G(PIECE)="" ""
   36: 	Q $P($P(ROOT,",",$L(ROOT,",")),")")_";"_PIECE
   37: 	;
   38: PIECE(DIQGR,DA,DR,DIQGPARM,DIQGTA,DIQGERRA,DIQGIPAR)	;CLOSEDREF,PIECE,ATTRIBUTE,FLAG,TARGETARRAY,ERRORARRAY,INTERNAL
   39: EN6	;PROCEDURE CALL AND  * * RETURN RESULTS IN TARGET ARRAY * *
   40: 	I $G(U)'="^" N U S U="^"
   41: 	N DIQGNP S DIQGR=$G(DIQGR),DA=$G(DA)
   42: 	S DIQGNP=$$NP(DIQGR,DA) I DIQGNP="" G 200
   43: 	S DIQGR=$$FN(DIQGR) I DIQGR="" G 200
   44: 	S DA=$$NPS(DIQGR,DIQGNP) I DA'>0 G 200
   45: 	G EN1^DIQGDD
   46: 	;
   47: 200	D BLD^DIALOG(200)
   48: 	I $G(DIQGERRA)]"" D CALLOUT^DIEFU(DIQGERRA)
   49: 	Q