source: IHS-VA_UTILITIES-XB/trunk/XBFIXPT.m@ 808

Last change on this file since 808 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 2.5 KB
Line 
1XBFIXPT ; 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 ;
8START ;
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 ;
20FPOS ; 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 ;
26CHKIT ;
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 ;
38FNEG ; 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 ;
44PTRCHK ;
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 ;
59PTRCHK2 ; 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 ;
Note: See TracBrowser for help on using the repository browser.