Return to DDUCHK2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDUCHK2	;SFISC/RWF-CHECK DD (FIELDS) ;5/28/91  2:35 PM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: CHK6	W !?5,"Checking FIELDs"
    5: 	F DDUCFE=0:0 S DDUCFE=+$O(^DD(DDUCFI,DDUCFE)) Q:DDUCFE'>0  D FIELD Q:$D(DIRUT)  D FIVE,XREF^DDUCHK3,COMP^DDUCHK3
    6: 	Q
    7: FIELD	W "."
    8: 	I $D(^DD(DDUCFI,DDUCFE,0))[0 W !?8,"Field: ",DDUCFE," is missing its zero node.  Nothing done."
    9: 	S DDUCX=^DD(DDUCFI,DDUCFE,0),DDUCX2=$P(DDUCX,U,2),DDUCX4=$P(DDUCX,U,4),DDUCXN=$P(DDUCX,U)
   10: 	;I DDUCX2["F",DDUCX4[";E1",$S($D(^DD(DDUCFI,DDUCFE,9)):^(9),1:"")'="@" D WHO W "doesn't have the correct protection for a field with executable code." I DDUCFIX S ^DD(DDUCFI,DDUCFE,9)="@" W !?10,"^DD(",DDUCFI,",",DDUCFE,",9) = ""@"" was set."
   11: 	D @$S(+DDUCX2:"MULT",DDUCX2["P":"PT",DDUCX2["V":"VP",1:"Q") Q
   12: 	Q
   13: FIVE	K DDUCXX F DDUCY=0:0 S DDUCY=$O(^DD(DDUCFI,DDUCFE,5,DDUCY)) Q:DDUCY'>0  S DDUCX=^(DDUCY,0) I $D(^DD(+DDUCX,+$P(DDUCX,U,2),1,+$P(DDUCX,U,3),0))#2 S DDUCXX(DDUCX)=""
   14: 	Q:'DDUCFIX
   15: 	K ^DD(DDUCFI,DDUCFE,5)
   16: 	S DDUCX="" F DDUCY=1:1 S DDUCX=$O(DDUCXX(DDUCX)) Q:DDUCX=""  S ^DD(DDUCFI,DDUCFE,5,DDUCY,0)=DDUCX
   17: 	Q
   18: VP	F DDUCY=0:0 S DDUCY=$O(^DD(DDUCFI,DDUCFE,"V",DDUCY)) Q:DDUCY'>0  S DDUCRFI=$S($D(^DD(DDUCFI,DDUCFE,"V",DDUCY,0)):^(0),1:"") I DDUCRFI D PT1
   19: 	Q
   20: PT	S DDUCRFI=+$P(DDUCX2,"P",2) I $D(^DD(DDUCRFI,0))[0 D WHO W "points to missing file: ",DDUCRFI Q
   21: PT1	I $D(^DD(+DDUCRFI,0,"PT",DDUCFI,DDUCFE))[0 D WHO W "is missing its 'PT' node in the pointed-to-file." I DDUCFIX S ^DD(+DDUCRFI,0,"PT",DDUCFI,DDUCFE)="" W !?10,"^DD(",+DDUCRFI,",0,""PT"",",DDUCFI,",",DDUCFE,") = """" was set."
   22: Q	Q  ;QUIT TAG
   23: MULT	;Work subfile
   24: 	D PAGE^DDUCHK Q:$D(DIRUT)
   25: 	I $D(^DD(+DDUCX2,0))[0 D WHO W "missing subfile: ",+DDUCX2 Q
   26: 	S DDUCUP=$S($D(^DD(+DDUCX2,0,"UP")):^("UP"),1:"") I DDUCUP'=DDUCFI D WHO W "Bad 'UP' pointer in subfile #",+DDUCX2 I DDUCFIX S ^DD(+DDUCX2,0,"UP")=DDUCFI W !?10,"^DD(",+DDUCX2,",0,""UP"") = ",DDUCFI," was set."
   27: 	D PUSH S DDUCFI=+DDUCX2 W !?3,"Checking subfile # ",DDUCFI D CHK^DDUCHK,POP W !?3,"Returning to ",$S('DDUCSTK:"main ",1:"sub"),"file",$S('DDUCSTK:".",1:" "_DDUCFI)
   28: 	Q
   29: PUSH	S DDUCSTK=DDUCSTK+1,DDUCSTK(DDUCSTK,1)=DDUCFI,DDUCSTK(DDUCSTK,2)=DDUCFE Q
   30: POP	S DDUCFI=DDUCSTK(DDUCSTK,1),DDUCFE=DDUCSTK(DDUCSTK,2),DDUCSTK=DDUCSTK-1 Q
   31: WHO	W !?8,"Field: ",DDUCFE," (",DDUCXN,") " Q