[641] | 1 | XBFIXPT ; IHS/ADC/GTH - FIX ALL "PT" NODES ; [ 11/04/97 10:26 AM ]
|
---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
---|
| 3 | ; XB*3*5 IHS/ADC/GTH 10-31-97 Prevent UNDEF if ^DD entry incorrect.
|
---|
| 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(XBFIXPT("NOTALK")) !!,"This routine insures the ""PT"" node of each FileMan file is correct.",!
|
---|
| 10 | W:'$D(XBFIXPT("NOTALK")) !!,"Now checking false positives.",!
|
---|
| 11 | S U="^"
|
---|
| 12 | S XBFFILE=.99999999
|
---|
| 13 | F XBFL=0:0 S XBFFILE=$O(^DD(XBFFILE)) Q:XBFFILE'=+XBFFILE I $D(^DD(XBFFILE,0,"PT")) W:'$D(XBFIXPT("NOTALK")) !,XBFFILE D FPOS
|
---|
| 14 | W:'$D(XBFIXPT("NOTALK")) !!,"Now checking false negatives.",!
|
---|
| 15 | D FNEG
|
---|
| 16 | KILL XBFFILE,XBFL
|
---|
| 17 | W:'$D(XBFIXPT("NOTALK")) !!,"DONE",!
|
---|
| 18 | Q
|
---|
| 19 | ;
|
---|
| 20 | FPOS ; CHECK FOR FALSE POSITIVES
|
---|
| 21 | S XBFPFILE=""
|
---|
| 22 | F XBFL=0:0 S XBFPFILE=$O(^DD(XBFFILE,0,"PT",XBFPFILE)) Q:XBFPFILE="" S XBFPFLD="" F XBFL=0:0 S XBFPFLD=$O(^DD(XBFFILE,0,"PT",XBFPFILE,XBFPFLD)) Q:XBFPFLD="" D CHKIT
|
---|
| 23 | KILL XBFPFILE,XBFPFLD,XBFX
|
---|
| 24 | Q
|
---|
| 25 | ;
|
---|
| 26 | CHKIT ;
|
---|
| 27 | W:'$D(XBFIXPT("NOTALK")) "."
|
---|
| 28 | I '$D(^DD(XBFPFILE)) W:'$D(XBFIXPT("NOTALK")) "|" KILL ^DD(XBFFILE,0,"PT",XBFPFILE) Q
|
---|
| 29 | ; I '$D(^DD(XBFPFILE,XBFPFLD)) W:'$D(XBFIXPT("NOTALK")) "|" KILL ^DD(XBFFILE,0,"PT",XBFPFILE,XBFPFLD) Q ; XB*3*5 IHS/ADC/GTH 10-31-97 Prevent UNDEF if ^DD entry incorrect.
|
---|
| 30 | I '$D(^DD(XBFPFILE,XBFPFLD,0)) W:'$D(XBFIXPT("NOTALK")) "|" KILL ^DD(XBFFILE,0,"PT",XBFPFILE,XBFPFLD) Q ; XB*3*5 IHS/ADC/GTH 10-31-97 Prevent UNDEF if ^DD entry incorrect.
|
---|
| 31 | S XBFX=$P(^DD(XBFPFILE,XBFPFLD,0),U,2)
|
---|
| 32 | I XBFX["P",XBFX[XBFFILE Q
|
---|
| 33 | I XBFX["V",$D(^DD(XBFPFILE,XBFPFLD,"V","B",XBFFILE)) Q
|
---|
| 34 | W:'$D(XBFIXPT("NOTALK")) "|"
|
---|
| 35 | KILL ^DD(XBFFILE,0,"PT",XBFPFILE,XBFPFLD)
|
---|
| 36 | Q
|
---|
| 37 | ;
|
---|
| 38 | FNEG ; CHECK FOR FALSE NEGATIVES
|
---|
| 39 | S XBFFILE=.99999999
|
---|
| 40 | F XBFL=0:0 S XBFFILE=$O(^DD(XBFFILE)) Q:XBFFILE'=+XBFFILE W:'$D(XBFIXPT("NOTALK")) !,XBFFILE S XBFFLD=0 F XBFL=0:0 S XBFFLD=$O(^DD(XBFFILE,XBFFLD)) Q:XBFFLD'=+XBFFLD D:$D(^(XBFFLD,0))#2 PTRCHK
|
---|
| 41 | KILL XBFFILE,XBFFLD,XBFX,XBFI
|
---|
| 42 | Q
|
---|
| 43 | ;
|
---|
| 44 | PTRCHK ;
|
---|
| 45 | S XBFX=$P(^DD(XBFFILE,XBFFLD,0),U,2)
|
---|
| 46 | I XBFX["V" D PTRCHK2 Q
|
---|
| 47 | Q:XBFX'["P"
|
---|
| 48 | F XBFI=1:1:$L(XBFX)+1 Q:$E(XBFX,XBFI)?1N
|
---|
| 49 | Q:XBFI>$L(XBFX)
|
---|
| 50 | S XBFX=$E(XBFX,XBFI,999),XBFX=+XBFX
|
---|
| 51 | Q:'XBFX
|
---|
| 52 | Q:XBFX<1 ;*** DOES NOT MESS WITH FILE NUMBERS < 1 ***
|
---|
| 53 | W:'$D(XBFIXPT("NOTALK")) "."
|
---|
| 54 | Q:'$D(^DIC(XBFX))
|
---|
| 55 | Q:'$D(^DD(XBFX,0))
|
---|
| 56 | I '$D(^DD(XBFX,0,"PT",XBFFILE,XBFFLD)) W "|" S ^(XBFFLD)=""
|
---|
| 57 | Q
|
---|
| 58 | ;
|
---|
| 59 | PTRCHK2 ; VARIABLE POINTER CHECK
|
---|
| 60 | S XBFX=""
|
---|
| 61 | F XBFL=0:0 S XBFX=$O(^DD(XBFFILE,XBFFLD,"V","B",XBFX)) Q:XBFX="" I '$D(^DD(XBFX,0,"PT",XBFFILE,XBFFLD)) W:'$D(XBFIXPT("NOTALK")) "|" S ^(XBFFLD)=""
|
---|
| 62 | Q
|
---|
| 63 | ;
|
---|