Return to DIDU1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIDU1.m, revision 1.1

1.1     ! snw         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:        ;