Annotation of freem_fileman/DITMU4.m, revision 1.1

1.1     ! snw         1: DITMU4 ;SFISC/EDE(OHPRD)-FIX ALL "PT" NODES ;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;
        !             5:        ; This routine fixes all "PT" nodes for files 1 through the
        !             6:        ; highest file number in the current UCI.
        !             7:        ;
        !             8: START  ;
        !             9:        W:'$D(DITMU4("NOTALK")) !!,"This routine insures the ""PT"" node of each FileMan file is correct.",!
        !            10:        W:'$D(DITMU4("NOTALK")) !!,"Now checking false positives.",!
        !            11:        S U="^"
        !            12:        S DITMU4FI=.99999999 F DITMU4L=0:0 S DITMU4FI=$O(^DD(DITMU4FI)) Q:DITMU4FI'=+DITMU4FI  I $D(^DD(DITMU4FI,0,"PT")) W:'$D(DITMU4("NOTALK")) !,DITMU4FI D FPOS
        !            13:        W:'$D(DITMU4("NOTALK")) !!,"Now checking false negatives.",!
        !            14:        D FNEG
        !            15:        K DITMU4FI,DITMU4L
        !            16:        W:'$D(DITMU4("NOTALK")) !!,"DONE",!
        !            17:        Q
        !            18:        ;
        !            19: FPOS   ; CHECK FOR FALSE POSITIVES
        !            20:        S DITMU4PF="" F DITMU4L=0:0 S DITMU4PF=$O(^DD(DITMU4FI,0,"PT",DITMU4PF)) Q:DITMU4PF=""  S DITMU4PD="" F DITMU4L=0:0 S DITMU4PD=$O(^DD(DITMU4FI,0,"PT",DITMU4PF,DITMU4PD)) Q:DITMU4PD=""  D CHKIT
        !            21:        K DITMU4PF,DITMU4PD,DITMU4X
        !            22:        Q
        !            23:        ;
        !            24: CHKIT  ;
        !            25:        W:'$D(DITMU4("NOTALK")) "."
        !            26:        I '$D(^DD(DITMU4PF)) W:'$D(DITMU4("NOTALK")) "|" K ^DD(DITMU4FI,0,"PT",DITMU4PF) Q
        !            27:        I '$D(^DD(DITMU4PF,DITMU4PD,0)) W:'$D(DITMU4("NOTALK")) "|" K ^DD(DITMU4FI,0,"PT",DITMU4PF,DITMU4PD) Q
        !            28:        S DITMU4X=$P(^DD(DITMU4PF,DITMU4PD,0),U,2)
        !            29:        I DITMU4X["P",DITMU4X[DITMU4FI Q
        !            30:        I DITMU4X["V",$D(^DD(DITMU4PF,DITMU4PD,"V","B",DITMU4FI)) Q
        !            31:        W:'$D(DITMU4("NOTALK")) "|" K ^DD(DITMU4FI,0,"PT",DITMU4PF,DITMU4PD)
        !            32:        Q
        !            33:        ;
        !            34: FNEG   ; CHECK FOR FALSE NEGATIVES
        !            35:        S DITMU4FI=.99999999 F DITMU4L=0:0 S DITMU4FI=$O(^DD(DITMU4FI)) Q:DITMU4FI'=+DITMU4FI  W:'$D(DITMU4("NOTALK")) !,DITMU4FI S DITMU4FD=0 F DITMU4L=0:0 S DITMU4FD=$O(^DD(DITMU4FI,DITMU4FD)) Q:DITMU4FD'=+DITMU4FD  D:$D(^(DITMU4FD,0))#2 PTRCHK
        !            36:        K DITMU4FI,DITMU4FD,DITMU4X,DITMU4I
        !            37:        Q
        !            38:        ;
        !            39: PTRCHK ;
        !            40:        S DITMU4X=$P(^(0),U,2)
        !            41:        I DITMU4X["V" D PTRCHK2 Q
        !            42:        Q:DITMU4X'["P"
        !            43:        F DITMU4I=1:1:$L(DITMU4X)+1 Q:$E(DITMU4X,DITMU4I)?1N
        !            44:        Q:DITMU4I>$L(DITMU4X)
        !            45:        S DITMU4X=$E(DITMU4X,DITMU4I,999),DITMU4X=+DITMU4X
        !            46:        Q:'DITMU4X
        !            47:        Q:DITMU4X<1  ;*** DOES NOT MESS WITH FILE NUMBERS < 1 ***
        !            48:        W:'$D(DITMU4("NOTALK")) "."
        !            49:        Q:'$D(^DIC(DITMU4X))
        !            50:        Q:'$D(^DD(DITMU4X,0))
        !            51:        I '$D(^DD(DITMU4X,0,"PT",DITMU4FI,DITMU4FD)) W "|" S ^(DITMU4FD)=""
        !            52:        Q
        !            53:        ;
        !            54: PTRCHK2        ; VARIABLE POINTER CHECK
        !            55:        S DITMU4X="" F DITMU4L=0:0 S DITMU4X=$O(^DD(DITMU4FI,DITMU4FD,"V","B",DITMU4X)) Q:DITMU4X=""  I '$D(^DD(DITMU4X,0,"PT",DITMU4FI,DITMU4FD)) W:'$D(DITMU4("NOTALK")) "|" S ^(DITMU4FD)=""
        !            56:        Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>