Return to DDUCHK2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDUCHK2.m, revision 1.1.1.1

1.1       snw         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