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 | ;
|
---|