Return to DITMU4.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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