Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIQGU

DIQGU.m

Go to the documentation of this file.
  1. DIQGU ;SFISC/DCL-DATA RETRIEVAL INTERNAL FUNCTIONS ;8FEB2011
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. DT(H) Q $$HTFM^DILIBF(H,1)
  1. ;
  1. ROOT(DIC,DA,CP,ERR) ;
  1. ENROOT S ERR=$G(ERR)=1
  1. N DIQGUFN,DIQGUIEN
  1. S DIQGUFN=$G(DIC),DIQGUIEN=$G(DA)
  1. I DIC="" D:ERR BLD^DIALOG(200) Q ""
  1. N RQ
  1. S RQ=$G(CP)'["Q"
  1. S CP=$G(CP)'[1
  1. G:$L($G(DA),",,")>1 ERR
  1. D:$G(DA)["," DAIEN(DA,.DA)
  1. I $G(^DIC(DIC,0,"GL"))]"" N DIQGUX S DIQGUX=^("GL") D:ERR Q:CP DIQGUX Q $$CREF(DIQGUX)
  1. .Q:$G(DIQGUIEN)'[","
  1. .N X S X=$$IENCHK^DIT3(DIQGUFN,DIQGUIEN)
  1. .Q:X
  1. .S (CP,DIQGUX)=""
  1. .Q
  1. N A,A2
  1. 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)
  1. .S A="" F S A=$O(A(A)) Q:A'<0 D
  1. ..I RQ S A2=$P(A(A),"^",2),DIC=DIC_DA($P(A,"-",2))_","_$$Q(A2)_"," Q
  1. ..S A2=$P(A(A),"^",2),DIC=DIC_DA($P(A,"-",2))_","""_A2_"""," Q
  1. ERR Q:'ERR ""
  1. S DIQGUIEN=$$IENS^DILF(.DA)
  1. S A=$$IENCHK^DIT3(DIQGUFN,DIQGUIEN) Q:'A ""
  1. D BLD^DIALOG(200) Q ""
  1. ;
  1. 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
  1. ;
  1. DA(Y) Q:$D(Y)=1 Y Q Y($O(Y(""),-1))
  1. ;
  1. UP(Y,A) N D,N,X
  1. S A(0)=Y F D=0:-1 Q:'$D(^DD(+A(D),0,"UP")) D Q:D=666
  1. .S X=^("UP"),N=$G(^DD($P(X,"^"),+$O(^DD($P(X,"^"),"SB",+A(D),"")),0)) I N="" S D=666 Q ;"UP" NODE MAY BE BOGUS!
  1. .S A(D-1)=$P(X,"^")_"^"_$P($P(N,"^",4),";")
  1. I D=666 Q Y
  1. Q $P(A($O(A(""))),"^")
  1. ;
  1. CREF(X) ;
  1. 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:"")
  1. OREF(X) ;
  1. ENOREF N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2,999)) Q:X2="" X1 Q X1_X2_","
  1. ;
  1. OR2(%) Q:%=")"!(%=",") "" Q:$L(%)=1 % S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
  1. ;
  1. RCP(%DIQGRCP) Q $$CREF($$R^DIQGU0(%DIQGRCP))
  1. ;
  1. Q(%Z) S %Z(%Z)="",%Z=$Q(%Z("")) Q $E(%Z,4,$L(%Z)-1)
  1. ;
  1. DY(Y) X ^DD("DD") Q Y ;*CCO/NI DATE FORMAT
  1. ;
  1. DAIEN(IEN,DA) ;
  1. K DA
  1. S DA=$P(IEN,",")
  1. N I F I=2:1 Q:$P(IEN,",",I)="" S DA(I-1)=$P(IEN,",",I)
  1. Q
  1. ;
  1. EXTERNAL(DIFILE,DIFIELD,DIFLAGS,DINTERNL,DIOUTPUT) ;SEA/TOAD
  1. G XTRNLX^DIDU
  1. ;