Return to DIDU1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIDU1.m, revision 1.1.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:        ;