Return to DDUCHK1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDUCHK1.m, revision 1.1

1.1     ! snw         1: DDUCHK1        ;SFISC/RWF-CHECK DD part 2 ;8/28/94  06:48
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: ID     S DDUCRFE="" F DDUCZ=0:0 S DDUCRFE=$O(^DD(DDUCFI,0,"ID",DDUCRFE)) Q:DDUCRFE=""  S DDUCX=$S($D(^DD(DDUCFI,0,"ID",DDUCRFE))#2:^(DDUCRFE),1:"") I DDUCX="Q" W !?5,"'ID' node for field ",DDUCRFE," = 'Q'" D:DDUCFIX ID1
        !             5:        Q
        !             6: ID1    K ^DD(DDUCFI,0,"ID",DDUCRFE) D M1 W """ID"",",DDUCRFE D M2
        !             7:        Q
        !             8: IX     S DDUCXREF="" F DDUCZ=0:0 S DDUCXREF=$O(^DD(DDUCFI,0,"IX",DDUCXREF)) Q:DDUCXREF=""  F DDUCRFI=0:0 S DDUCRFI=$O(^DD(DDUCFI,0,"IX",DDUCXREF,DDUCRFI)) Q:DDUCRFI'>0  D IX1
        !             9:        Q
        !            10: IX1    F DDUCRFE=0:0 S DDUCRFE=$O(^DD(DDUCFI,0,"IX",DDUCXREF,DDUCRFI,DDUCRFE)) Q:DDUCRFE'>0  D
        !            11:        . I $D(^DD(DDUCRFI,DDUCRFE,0))[0 D WFI,WFE,WMS D:DDUCFIX IX2 Q
        !            12:        . I $D(^DD(DDUCRFI,DDUCRFE,1,0))=0,$D(^DD(DDUCRFI,DDUCRFE,1))=10 S:DDUCFIX ^DD(DDUCRFI,DDUCRFE,1,0)="^.1"
        !            13:        . S DDUCRFE1=0,DDUCRFEX="" F  S DDUCRFE1=$O(^DD(DDUCRFI,DDUCRFE,1,DDUCRFE1)) Q:DDUCRFE1'>0  S DDUCRFEX=$G(^(DDUCRFE1,0)) I $P(DDUCRFEX,U,2)=DDUCXREF K DDUCRFEX Q
        !            14:        . I $D(DDUCRFEX) W !?5,"Cross-reference logic is missing for """,DDUCXREF,""" x-ref" D:DDUCFIX IX2 Q
        !            15:        K DDUCRFE1 Q
        !            16: IX2    K ^DD(DDUCFI,0,"IX",DDUCXREF,DDUCRFI,DDUCRFE) D M1 W """IX"",",DDUCXREF_","_DDUCRFI_","_DDUCRFE D M2
        !            17:        Q
        !            18: PT     F DDUCRFI=0:0 S DDUCRFI=$O(^DD(DDUCFI,0,"PT",DDUCRFI)) Q:DDUCRFI'>0  F DDUCRFE=0:0 S DDUCRFE=$O(^DD(DDUCFI,0,"PT",DDUCRFI,DDUCRFE)) Q:DDUCRFE'>0  D PT1
        !            19:        Q
        !            20: PT1    I $D(^DD(DDUCRFI,0))[0 D WFI,WMS I DDUCFIX K ^DD(DDUCFI,0,"PT",DDUCRFI) D M1 W """PT"",",DDUCRFI D M2 Q
        !            21:        I $D(^DD(DDUCRFI,DDUCRFE,0))[0 D WFI,WFE,WMS D:DDUCFIX PTM Q
        !            22:        I ($P(^(0),U,2)'["P")&($P(^(0),U,2)'["V") D WFI,WFE W "is not a pointer." D:DDUCFIX PTM Q
        !            23:        I $P(^(0),U,2)["P",+$P($P(^(0),U,2),"P",2)'=DDUCFI D WFI,WFE W "is not a pointer to file ",DDUCFI D:DDUCFIX PTM
        !            24:        Q
        !            25: PTM    K ^DD(DDUCFI,0,"PT",DDUCRFI,DDUCRFE)
        !            26:        D M1 W """PT"",",DDUCRFI,",",DDUCRFE D M2
        !            27:        Q
        !            28: AC     F DDUCFE=0:0 S DDUCFE=$O(^DD("ACOMP",DDUCFI,DDUCFE)) Q:DDUCFE'>0  D AC1
        !            29:        Q
        !            30: AC1    F DDUCRFI=0:0 S DDUCRFI=$O(^DD("ACOMP",DDUCFI,DDUCFE,DDUCRFI)) Q:DDUCRFI'>0  F DDUCRFE=0:0 S DDUCRFE=$O(^DD("ACOMP",DDUCFI,DDUCFE,DDUCRFI,DDUCRFE)) Q:DDUCRFE'>0  D AC2
        !            31:        Q
        !            32: AC2    I $D(^DD(DDUCRFI,DDUCRFE,0))[0 D:DDUCFIX ACM Q
        !            33:        S DDUCX=^(0) I $P(DDUCX,U,2)'["C" D:DDUCFIX ACM Q
        !            34:        I $P(DDUCX,U,2)["C" S DDUCX1=$S($D(^(9.01)):^(9.01),1:""),DDUCF=0 D AC3
        !            35:        Q
        !            36: AC3    F DDUCZ=1:1 S DDUCX2=$P(DDUCX1,";",DDUCZ) Q:DDUCX2=""  I DDUCX2=DDUCFI_U_DDUCFE S DDUCF=1 Q
        !            37:        I 'DDUCF D:DDUCFIX ACM
        !            38:        Q
        !            39: ACM    K ^DD("ACOMP",DDUCFI,DDUCFE,DDUCRFI,DDUCRFE)
        !            40:        Q
        !            41: NM     S DDUCRFI(1)=$S($D(^DIC(DDUCFI,0))#2:$P(^(0),U),1:$P(^DD(DDUCFI,0)," SUB-FIELD"))
        !            42:        Q:DDUCRFI(1)']""  K ^DD(DDUCFI,0,"NM") S ^DD(DDUCFI,0,"NM",DDUCRFI(1))="" W !?10,"Duplicate ""NM"" node was deleted."
        !            43:        Q
        !            44: WHO    W !?5,"Field: ",DDUCFE," (",$P(DDUCX,U),") " Q
        !            45: WFI    W !?5,"File: ",DDUCRFI," " Q
        !            46: WFE    W ?5,"Field: ",DDUCRFE," " Q
        !            47: WMS    W "is missing." Q
        !            48: M1     W !?10,"^DD(",DDUCFI,",0," Q
        !            49: M2     W ") was killed." Q