72 lines
2.1 KiB
Mathematica
72 lines
2.1 KiB
Mathematica
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
|
|
;
|