Return to DDUCHK.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDUCHK.m, revision 1.1

1.1     ! snw         1: DDUCHK ;SFISC/RWF-CHECK DD ;8/12/94  9:01 AM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ; DDUCFI=home file, DDUCFE=home field, DDUCFIX=flag to fix DD
        !             5:        ; DDUCRFI=referenced file, DDUCRFE=referenced field.
        !             6: A      W !!,"Check the Data Dictionary." S DDUC="" D DT^DICRW,L^DICRW1 G EXIT:X'>0 S DDUCFIS=+X-.000001,DDUCFIE=DIB(1)
        !             7:        S DIR(0)="Y",DIR("A")="Remove erroneous nodes",DIR("B")="NO",DIR("?",1)="This routine will try to fix certain nodes that are erroneous and may set some nodes to a file referenced by the selected file."
        !             8:        S DIR("?")="Say 'NO' here to leave the DD untouched.  It will only flag the ones it finds erroneous."
        !             9:        D ^DIR G EXIT:$D(DIRUT) S DDUCFIX=+Y K DIR
        !            10: ZIS    S %ZIS="Q" D ^%ZIS G EXIT:POP
        !            11:        I $D(IO("Q")) S ZTRTN="DQ^DDUCHK",ZTSAVE("DDUCFIX")="",ZTSAVE("DDUCFIS")="",ZTSAVE("DDUCFIE")="" D ^%ZTLOAD G EXIT
        !            12: DQ     U IO K DDUCSTK S DDUCSTK=0,DDUCFX=DDUCFIX
        !            13:        F DDUCFILE=DDUCFIS:0:DDUCFIE S DDUCFILE=$O(^DIC(DDUCFILE)) Q:DDUCFILE'>0!(DDUCFILE>DDUCFIE)  D PAGE Q:$D(DIRUT)  W !!,"Checking file # ",DDUCFILE S (DDUCFI,DIFILE)=+DDUCFILE D DDAC,CHK
        !            14: EXIT   D ^%ZISC
        !            15:        K DDUCFI,DDUCFIX,DDUCFILE,DDUCFIS,DDUCFIE,DDUCFE,DDUCX,DDUCX1,DDUCX2,DDUCX4,DDUCRFI
        !            16:        K DDUCRFE,DDUCSTK,DDUCSTK,DDUCDNAM,DDUCNAME,DDUCXX,DDUCY,DDUCUP,DDUCXN
        !            17:        K DDUCF,DDUCXREF,DDUCZ,DDUC5,DDUCYY,DDUCYY1,DDUCOK,DDUCYYX,DIB,DDUC,DDUCFX,DIAC,DIFILE
        !            18:        Q
        !            19: PAGE   I $Y+3>IOSL S DIR(0)="E" D:IOST["C-" ^DIR W @IOF
        !            20:        Q
        !            21:        ;
        !            22: DDAC   I DUZ(0)'="@" S DIAC="DD" D ^DIAC S DDUCFIX=DDUCFX I 'DIAC,DDUCFX W !,"You don't have DD access to this file.  No fixing will be done on this file." S DDUCFIX=0 Q
        !            23:        Q
        !            24: CHK    I $G(^DIC(DDUCFI,0))]"",'$P(^(0),U,2) S:DDUCFIX $P(^(0),U,2)=DDUCFI
        !            25:        I $D(^DD(DDUCFI,0))[0 S DDUCRFI=DDUCFI D WFI W "is missing zero node of DD."
        !            26:        I $D(^DD(DDUCFI,0,"ID")) W !?5,"Checking 'ID' nodes for 'Q'." D ID^DDUCHK1
        !            27:        I $D(^DD(DDUCFI,0,"IX")) W !?5,"Checking 'IX' nodes." D IX^DDUCHK1
        !            28:        I $D(^DD(DDUCFI,0,"PT")) W !?5,"Checking 'PT' nodes." D PT^DDUCHK1
        !            29:        S DDUCNAME=$O(^DD(DDUCFI,0,"NM","")),DDUCDNAM=$O(^(DDUCNAME)),DDUCRFI=DDUCFI I DDUCDNAM]"" D WFI W "has duplicate 'NM' nodes." I DDUCFIX D NM^DDUCHK1
        !            30:        I $D(^DD("ACOMP",DDUCFI)) D AC^DDUCHK1
        !            31:        G ^DDUCHK2
        !            32: WFI    W !?8,"File: ",DDUCRFI," " Q
        !            33:        ;
        !            34: EN     ;
        !            35:        Q:'$D(DDUCFI)!'$D(DDUCFIX)  S U="^"
        !            36:        I DDUCFI Q:'$D(^DIC(DDUCFI,0,"GL"))  G EN1
        !            37:        Q:'$D(@(DDUCFI_"0)"))  S DDUCFI=+$P(^(0),U,2)
        !            38: EN1    S DDUCFIS=+DDUCFI-.000001,DDUCFIE=+DDUCFI
        !            39:        G ZIS