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

DIDU1.m

Go to the documentation of this file.
DIDU1 ;SEA/TOAD-VA FileMan: DD Tools, IENS Check ;10:39 AM  8 Jul 1998
 ;;22.0;VA FileMan;;Mar 30, 1999
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
IEN(DIENS,DIFLAGS) ;
 ;ENTRY POINT--return whether the IEN String is valid
 ;extrinsic function, all passed by value
 I $G(DIENS)="" Q 0
 I $G(DIFLAGS,"N")'="N" Q 0
 S DIFLAGS=$G(DIFLAGS)
 N DICHAR,DICRSR,DIPIECE,DISEQ,DIOUT,DIVALID
 S DIPIECE="",DISEQ="",DIOUT=0,DIVALID=1
 F DICRSR=1:1 D  I DIOUT Q
 .S DIPIECE=$P(DIENS,",",DICRSR)
 .I DIPIECE="" D  Q
 ..I $P(DIENS,",",DICRSR,999)="" S DIOUT=1 Q
I1 ..I DICRSR=1 Q
 ..S DIOUT=1,DIVALID=0
 ..Q
 .I +DIPIECE=DIPIECE S DIVALID=DIPIECE>0,DIOUT='DIVALID Q
 .I DIFLAGS["N" S DIVALID=0,DIOUT=1 Q
 .S DICHAR=$E(DIPIECE,1,2) I DICHAR'="?+" S DICHAR=$E(DICHAR)
 .I DICHAR'="+",DICHAR'="?",DICHAR'="?+" S DIOUT=1,DIVALID=0 Q
 .I $P(DIPIECE,DICHAR,2,9999)?1N.N D  Q
 ..S DISEQ=$P(DIPIECE,DICHAR,2,999)
 ..S DIOUT=+DISEQ'=DISEQ!$D(DISEQ(DISEQ)),DIVALID='DIOUT Q
I2 .S DIOUT=1,DIVALID=0
 .Q
 Q $E(DIENS,$L(DIENS))=","&DIVALID
 ;
PROOT(DIFILE,DIENS) ;
 ;ENTRY POINT--return the global root of a subfile's parent
 ;extrinsic function, all passed by value
 Q $$ROOT^DILFD($$PARENT(DIFILE),$P(DIENS,",",2,999),1)
 ;
PARENT(DIFILE) ;
 ;ENTRY POINT--return the file number of a subfile's parent
 ;extrinsic function, all passed by value
 Q $G(^DD(DIFILE,0,"UP"))
 ;
PARENTS(DIFILE,DIRULE) ;
 ;IEN--return the file's parents
 ;procedure, passed by ref
 N DIBACK,DIOUT,DIMOM,DITEMP
 S DIOUT=0,DIMOM=DIFILE
 S DITEMP=DIFILE K DIFILE S (DIFILE,DIFILE("C"))=DITEMP
 S DIFILE("L")=$$LEVEL(DIFILE)
 S DIFILE(1)=DIFILE
 I '$D(DIRULE("L",DIFILE)) S DIRULE("L",DIFILE)=DIFILE("L")
 F DIBACK=2:1 D  I DIOUT Q
 .S DITEMP=DIMOM
 .S DIMOM=$G(DIRULE("UP",DITEMP))
PA1 .I DIMOM="" D  I DIOUT Q
 ..S DIMOM=$G(^DD(DITEMP,0,"UP"))
 ..I DIMOM="" S DIOUT=1 Q
 ..S DIRULE("UP",DITEMP)=DIMOM
 ..I '$D(DIRULE("L",DIMOM)) S DIRULE("L",DIMOM)=DIFILE("L")-DIBACK+1
 ..Q
 .S DIFILE(DIBACK)=DIMOM
 .Q
 Q
 ;
LEVEL(DIFILE) ;
 ;IEN--return the file's level (# parents +1)
 ;function, pass by value
 N DIMOM
 I '$G(DIFILE) Q 0
 S DIMOM=$G(^DD(DIFILE,0,"UP"))
 I DIMOM="" Q 1
 Q $$LEVEL(DIMOM)+1
 ;