source: IHS-VA_UTILITIES-XB/XBFIXPT.m@ 641

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

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.