| 1 | DIQGU ;SFISC/DCL-DATA RETRIEVAL INTERNAL FUNCTIONS ;11/4/97 14:56
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | DT(H) Q $$HTFM^DILIBF(H,1)
|
|---|
| 5 | ;
|
|---|
| 6 | ROOT(DIC,DA,CP,ERR) ;
|
|---|
| 7 | ENROOT S ERR=$G(ERR)=1
|
|---|
| 8 | N DIQGUFN,DIQGUIEN
|
|---|
| 9 | S DIQGUFN=$G(DIC),DIQGUIEN=$G(DA)
|
|---|
| 10 | I DIC="" D:ERR BLD^DIALOG(200) Q ""
|
|---|
| 11 | N RQ
|
|---|
| 12 | S RQ=$G(CP)'["Q"
|
|---|
| 13 | S CP=$G(CP)'[1
|
|---|
| 14 | G:$L($G(DA),",,")>1 ERR
|
|---|
| 15 | D:$G(DA)["," DAIEN(DA,.DA)
|
|---|
| 16 | I $G(^DIC(DIC,0,"GL"))]"" N DIQGUX S DIQGUX=^("GL") D:ERR Q:CP DIQGUX Q $$CREF(DIQGUX)
|
|---|
| 17 | .Q:$G(DIQGUIEN)'[","
|
|---|
| 18 | .N X S X=$$IENCHK^DIT3(DIQGUFN,DIQGUIEN)
|
|---|
| 19 | .Q:X
|
|---|
| 20 | .S (CP,DIQGUX)=""
|
|---|
| 21 | .Q
|
|---|
| 22 | N A,A2
|
|---|
| 23 | 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)
|
|---|
| 24 | .S A="" F S A=$O(A(A)) Q:A'<0 D
|
|---|
| 25 | ..I RQ S A2=$P(A(A),"^",2),DIC=DIC_DA($P(A,"-",2))_","_$$Q(A2)_"," Q
|
|---|
| 26 | ..S A2=$P(A(A),"^",2),DIC=DIC_DA($P(A,"-",2))_","""_A2_"""," Q
|
|---|
| 27 | ERR Q:'ERR ""
|
|---|
| 28 | S DIQGUIEN=$$IENS^DILF(.DA)
|
|---|
| 29 | S A=$$IENCHK^DIT3(DIQGUFN,DIQGUIEN) Q:'A ""
|
|---|
| 30 | D BLD^DIALOG(200) Q ""
|
|---|
| 31 | 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
|
|---|
| 32 | DA(Y) Q:$D(Y)=1 Y Q Y($O(Y(""),-1))
|
|---|
| 33 | UP(Y,A) N D
|
|---|
| 34 | 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),";")
|
|---|
| 35 | Q $P(A($O(A(""))),"^")
|
|---|
| 36 | CREF(X) ;
|
|---|
| 37 | 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:"")
|
|---|
| 38 | OREF(X) ;
|
|---|
| 39 | ENOREF N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2)) Q:X2="" X1 Q X1_X2_","
|
|---|
| 40 | OR2(%) Q:%=")"!(%=",") "" Q:$L(%)=1 % S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
|
|---|
| 41 | RCP(%DIQGRCP) Q $$CREF($$R^DIQGU0(%DIQGRCP))
|
|---|
| 42 | Q(%Z) S %Z(%Z)="",%Z=$Q(%Z("")) Q $E(%Z,4,$L(%Z)-1)
|
|---|
| 43 | DY(Y) S %=$E(Y,4,5)*3 Q $E("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",%-2,%)_" "_$S($E(Y,6,7):$J(+$E(Y,6,7),2)_", ",1:"")_($E(Y,1,3)+1700)_$S(Y[".":"@"_$E(Y_0,9,10)_":"_$E(Y_"000",11,12)_$S($E(Y,13,14):":"_$E(Y_0,13,14),1:""),1:"")
|
|---|
| 44 | DAIEN(IEN,DA) ;
|
|---|
| 45 | K DA
|
|---|
| 46 | S DA=$P(IEN,",")
|
|---|
| 47 | N I F I=2:1 Q:$P(IEN,",",I)="" S DA(I-1)=$P(IEN,",",I)
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | EXTERNAL(DIFILE,DIFIELD,DIFLAGS,DINTERNL,DIOUTPUT) ;SEA/TOAD
|
|---|
| 51 | G XTRNLX^DIDU
|
|---|
| 52 | ;
|
|---|
