Return to DDUCHK.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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