| 1 | DIDU1 ;SEA/TOAD-VA FileMan: DD Tools, IENS Check ;10:39 AM 8 Jul 1998
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | IEN(DIENS,DIFLAGS) ;
|
|---|
| 6 | ;ENTRY POINT--return whether the IEN String is valid
|
|---|
| 7 | ;extrinsic function, all passed by value
|
|---|
| 8 | I $G(DIENS)="" Q 0
|
|---|
| 9 | I $G(DIFLAGS,"N")'="N" Q 0
|
|---|
| 10 | S DIFLAGS=$G(DIFLAGS)
|
|---|
| 11 | N DICHAR,DICRSR,DIPIECE,DISEQ,DIOUT,DIVALID
|
|---|
| 12 | S DIPIECE="",DISEQ="",DIOUT=0,DIVALID=1
|
|---|
| 13 | F DICRSR=1:1 D I DIOUT Q
|
|---|
| 14 | .S DIPIECE=$P(DIENS,",",DICRSR)
|
|---|
| 15 | .I DIPIECE="" D Q
|
|---|
| 16 | ..I $P(DIENS,",",DICRSR,999)="" S DIOUT=1 Q
|
|---|
| 17 | I1 ..I DICRSR=1 Q
|
|---|
| 18 | ..S DIOUT=1,DIVALID=0
|
|---|
| 19 | ..Q
|
|---|
| 20 | .I +DIPIECE=DIPIECE S DIVALID=DIPIECE>0,DIOUT='DIVALID Q
|
|---|
| 21 | .I DIFLAGS["N" S DIVALID=0,DIOUT=1 Q
|
|---|
| 22 | .S DICHAR=$E(DIPIECE,1,2) I DICHAR'="?+" S DICHAR=$E(DICHAR)
|
|---|
| 23 | .I DICHAR'="+",DICHAR'="?",DICHAR'="?+" S DIOUT=1,DIVALID=0 Q
|
|---|
| 24 | .I $P(DIPIECE,DICHAR,2,9999)?1N.N D Q
|
|---|
| 25 | ..S DISEQ=$P(DIPIECE,DICHAR,2,999)
|
|---|
| 26 | ..S DIOUT=+DISEQ'=DISEQ!$D(DISEQ(DISEQ)),DIVALID='DIOUT Q
|
|---|
| 27 | I2 .S DIOUT=1,DIVALID=0
|
|---|
| 28 | .Q
|
|---|
| 29 | Q $E(DIENS,$L(DIENS))=","&DIVALID
|
|---|
| 30 | ;
|
|---|
| 31 | PROOT(DIFILE,DIENS) ;
|
|---|
| 32 | ;ENTRY POINT--return the global root of a subfile's parent
|
|---|
| 33 | ;extrinsic function, all passed by value
|
|---|
| 34 | Q $$ROOT^DILFD($$PARENT(DIFILE),$P(DIENS,",",2,999),1)
|
|---|
| 35 | ;
|
|---|
| 36 | PARENT(DIFILE) ;
|
|---|
| 37 | ;ENTRY POINT--return the file number of a subfile's parent
|
|---|
| 38 | ;extrinsic function, all passed by value
|
|---|
| 39 | Q $G(^DD(DIFILE,0,"UP"))
|
|---|
| 40 | ;
|
|---|
| 41 | PARENTS(DIFILE,DIRULE) ;
|
|---|
| 42 | ;IEN--return the file's parents
|
|---|
| 43 | ;procedure, passed by ref
|
|---|
| 44 | N DIBACK,DIOUT,DIMOM,DITEMP
|
|---|
| 45 | S DIOUT=0,DIMOM=DIFILE
|
|---|
| 46 | S DITEMP=DIFILE K DIFILE S (DIFILE,DIFILE("C"))=DITEMP
|
|---|
| 47 | S DIFILE("L")=$$LEVEL(DIFILE)
|
|---|
| 48 | S DIFILE(1)=DIFILE
|
|---|
| 49 | I '$D(DIRULE("L",DIFILE)) S DIRULE("L",DIFILE)=DIFILE("L")
|
|---|
| 50 | F DIBACK=2:1 D I DIOUT Q
|
|---|
| 51 | .S DITEMP=DIMOM
|
|---|
| 52 | .S DIMOM=$G(DIRULE("UP",DITEMP))
|
|---|
| 53 | PA1 .I DIMOM="" D I DIOUT Q
|
|---|
| 54 | ..S DIMOM=$G(^DD(DITEMP,0,"UP"))
|
|---|
| 55 | ..I DIMOM="" S DIOUT=1 Q
|
|---|
| 56 | ..S DIRULE("UP",DITEMP)=DIMOM
|
|---|
| 57 | ..I '$D(DIRULE("L",DIMOM)) S DIRULE("L",DIMOM)=DIFILE("L")-DIBACK+1
|
|---|
| 58 | ..Q
|
|---|
| 59 | .S DIFILE(DIBACK)=DIMOM
|
|---|
| 60 | .Q
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | LEVEL(DIFILE) ;
|
|---|
| 64 | ;IEN--return the file's level (# parents +1)
|
|---|
| 65 | ;function, pass by value
|
|---|
| 66 | N DIMOM
|
|---|
| 67 | I '$G(DIFILE) Q 0
|
|---|
| 68 | S DIMOM=$G(^DD(DIFILE,0,"UP"))
|
|---|
| 69 | I DIMOM="" Q 1
|
|---|
| 70 | Q $$LEVEL(DIMOM)+1
|
|---|
| 71 | ;
|
|---|
