Return to DIDU1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIDU1	;SEA/TOAD-VA FileMan: DD Tools, IENS Check ;7/17/94  17:28 ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    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: 	;