DIQGU ;SFISC/DCL-DATA RETRIEVAL INTERNAL FUNCTIONS ;16JAN2010
;;22.0;VA FileMan;**163**;Mar 30, 1999;Build 30
;Per VHA Directive 2004-038, this routine should not be modified.
DT(H) Q $$HTFM^DILIBF(H,1)
;
ROOT(DIC,DA,CP,ERR) ;
ENROOT S ERR=$G(ERR)=1
N DIQGUFN,DIQGUIEN
S DIQGUFN=$G(DIC),DIQGUIEN=$G(DA)
I DIC="" D:ERR BLD^DIALOG(200) Q ""
N RQ
S RQ=$G(CP)'["Q"
S CP=$G(CP)'[1
G:$L($G(DA),",,")>1 ERR
D:$G(DA)["," DAIEN(DA,.DA)
I $G(^DIC(DIC,0,"GL"))]"" N DIQGUX S DIQGUX=^("GL") D:ERR Q:CP DIQGUX Q $$CREF(DIQGUX)
.Q:$G(DIQGUIEN)'[","
.N X S X=$$IENCHK^DIT3(DIQGUFN,DIQGUIEN)
.Q:X
.S (CP,DIQGUX)=""
.Q
N A,A2
I $D(DA)>9,$G(^DIC(+$$UP(DIC,.A),0,"GL"))]"" S DIC=^("GL"),A=$P($O(A("")),"-",2) I A>0,$D(DA(A))=1,'$O(DA(A)) D Q:CP DIC Q $$CREF(DIC)
.S A="" F S A=$O(A(A)) Q:A'<0 D
..I RQ S A2=$P(A(A),"^",2),DIC=DIC_DA($P(A,"-",2))_","_$$Q(A2)_"," Q
..S A2=$P(A(A),"^",2),DIC=DIC_DA($P(A,"-",2))_","""_A2_"""," Q
ERR Q:'ERR ""
S DIQGUIEN=$$IENS^DILF(.DA)
S A=$$IENCHK^DIT3(DIQGUFN,DIQGUIEN) Q:'A ""
D BLD^DIALOG(200) Q ""
N9(FN,DA) Q:$G(DA)="" 0 N N9 S N9=$$ROOT($$UP(FN),"",1) Q:N9="" 0 Q:$D(@N9@($$DA(.DA),-9)) 1 Q 0
DA(Y) Q:$D(Y)=1 Y Q Y($O(Y(""),-1))
UP(Y,A) N D
S A(0)=Y F D=0:-1 Q:'$D(^DD(+A(D),0,"UP")) S A(D-1)=$P(^("UP"),"^")_"^"_$P($P(^DD($P(^("UP"),"^"),$O(^DD($P(^("UP"),"^"),"SB",+A(D),"")),0),"^",4),";")
Q $P(A($O(A(""))),"^")
CREF(X) ;
ENCREF N L,X1,X2,X3 S X1=$P(X,"("),X2=$P(X,"(",2,99),L=$L(X2),X3=$TR($E(X2,L),",)"),X2=$E(X2,1,(L-1))_X3 Q X1_$S(X2]"":"("_X2_")",1:"")
OREF(X) ;
ENOREF N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2,999)) Q:X2="" X1 Q X1_X2_","
OR2(%) Q:%=")"!(%=",") "" Q:$L(%)=1 % S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
RCP(%DIQGRCP) Q $$CREF($$R^DIQGU0(%DIQGRCP))
Q(%Z) S %Z(%Z)="",%Z=$Q(%Z("")) Q $E(%Z,4,$L(%Z)-1)
DY(Y) X ^DD("DD") Q Y ;*CCO/NI DATE FORMAT
DAIEN(IEN,DA) ;
K DA
S DA=$P(IEN,",")
N I F I=2:1 Q:$P(IEN,",",I)="" S DA(I-1)=$P(IEN,",",I)
Q
;
EXTERNAL(DIFILE,DIFIELD,DIFLAGS,DINTERNL,DIOUTPUT) ;SEA/TOAD
G XTRNLX^DIDU
;
DIQGU ;SFISC/DCL-DATA RETRIEVAL INTERNAL FUNCTIONS ;16JAN2010
+1 ;;22.0;VA FileMan;**163**;Mar 30, 1999;Build 30
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
DT(H) QUIT $$HTFM^DILIBF(H,1)
+1 ;
ROOT(DIC,DA,CP,ERR) ;
ENROOT SET ERR=$GET(ERR)=1
+1 NEW DIQGUFN,DIQGUIEN
+2 SET DIQGUFN=$GET(DIC)
SET DIQGUIEN=$GET(DA)
+3 IF DIC=""
IF ERR
DO BLD^DIALOG(200)
QUIT ""
+4 NEW RQ
+5 SET RQ=$GET(CP)'["Q"
+6 SET CP=$GET(CP)'[1
+7 IF $LENGTH($GET(DA),",,")>1
GOTO ERR
+8 IF $GET(DA)[","
DO DAIEN(DA,.DA)
+9 IF $GET(^DIC(DIC,0,"GL"))]""
NEW DIQGUX
SET DIQGUX=^("GL")
IF ERR
Begin DoDot:1
+10 IF $GET(DIQGUIEN)'[","
QUIT
+11 NEW X
SET X=$$IENCHK^DIT3(DIQGUFN,DIQGUIEN)
+12 IF X
QUIT
+13 SET (CP,DIQGUX)=""
+14 QUIT
End DoDot:1
IF CP
QUIT DIQGUX
QUIT $$CREF(DIQGUX)
+15 NEW A,A2
+16 IF $DATA(DA)>9
IF $GET(^DIC(+$$UP(DIC,.A),0,"GL"))]""
SET DIC=^("GL")
SET A=$PIECE($ORDER(A("")),"-",2)
IF A>0
IF $DATA(DA(A))=1
IF '$ORDER(DA(A))
Begin DoDot:1
+17 SET A=""
FOR
SET A=$ORDER(A(A))
IF A'<0
QUIT
Begin DoDot:2
+18 IF RQ
SET A2=$PIECE(A(A),"^",2)
SET DIC=DIC_DA($PIECE(A,"-",2))_","_$$Q(A2)_","
QUIT
+19 SET A2=$PIECE(A(A),"^",2)
SET DIC=DIC_DA($PIECE(A,"-",2))_","""_A2_""","
QUIT
End DoDot:2
End DoDot:1
IF CP
QUIT DIC
QUIT $$CREF(DIC)
ERR IF 'ERR
QUIT ""
+1 SET DIQGUIEN=$$IENS^DILF(.DA)
+2 SET A=$$IENCHK^DIT3(DIQGUFN,DIQGUIEN)
IF 'A
QUIT ""
+3 DO BLD^DIALOG(200)
QUIT ""
N9(FN,DA) IF $GET(DA)=""
QUIT 0
NEW N9
SET N9=$$ROOT($$UP(FN),"",1)
IF N9=""
QUIT 0
IF $DATA(@N9@($$DA(.DA),-9))
QUIT 1
QUIT 0
DA(Y) IF $DATA(Y)=1
QUIT Y
QUIT Y($ORDER(Y(""),-1))
UP(Y,A) NEW D
+1 SET A(0)=Y
FOR D=0:-1
IF '$DATA(^DD(+A(D),0,"UP"))
QUIT
SET A(D-1)=$PIECE(^("UP"),"^")_"^"_$PIECE($PIECE(^DD($PIECE(^("UP"),"^"),$ORDER(^DD($PIECE(^("UP"),"^"),"SB",+A(D),"")),0),"^",4),";")
+2 QUIT $PIECE(A($ORDER(A(""))),"^")
CREF(X) ;
ENCREF NEW L,X1,X2,X3
SET X1=$PIECE(X,"(")
SET X2=$PIECE(X,"(",2,99)
SET L=$LENGTH(X2)
SET X3=$TRANSLATE($EXTRACT(X2,L),",)")
SET X2=$EXTRACT(X2,1,(L-1))_X3
QUIT X1_$SELECT(X2]"":"("_X2_")",1:"")
OREF(X) ;
ENOREF NEW X1,X2
SET X1=$PIECE(X,"(")_"("
SET X2=$$OR2($PIECE(X,"(",2,999))
IF X2=""
QUIT X1
QUIT X1_X2_","
OR2(%) IF %=")"!(%=",")
QUIT ""
IF $LENGTH(%)=1
QUIT %
IF "),"[$EXTRACT(%,$LENGTH(%))
SET %=$EXTRACT(%,1,$LENGTH(%)-1)
QUIT %
RCP(%DIQGRCP) QUIT $$CREF($$R^DIQGU0(%DIQGRCP))
Q(%Z) SET %Z(%Z)=""
SET %Z=$QUERY(%Z(""))
QUIT $EXTRACT(%Z,4,$LENGTH(%Z)-1)
DY(Y) ;*CCO/NI DATE FORMAT
XECUTE ^DD("DD")
QUIT Y
DAIEN(IEN,DA) ;
+1 KILL DA
+2 SET DA=$PIECE(IEN,",")
+3 NEW I
FOR I=2:1
IF $PIECE(IEN,",",I)=""
QUIT
SET DA(I-1)=$PIECE(IEN,",",I)
+4 QUIT
+5 ;
EXTERNAL(DIFILE,DIFIELD,DIFLAGS,DINTERNL,DIOUTPUT) ;SEA/TOAD
+1 GOTO XTRNLX^DIDU
+2 ;
