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>