XBFIXPT ; IHS/ADC/GTH - FIX ALL "PT" NODES ; [ 11/04/97 10:26 AM ]
;;3.0;IHS/VA UTILITIES;**5**;FEB 07, 1997
; XB*3*5 IHS/ADC/GTH 10-31-97 Prevent UNDEF if ^DD entry incorrect.
;
; This routine fixes all "PT" nodes for files 1 through the
; highest file number in the current UCI.
;
START ;
W:'$D(XBFIXPT("NOTALK")) !!,"This routine insures the ""PT"" node of each FileMan file is correct.",!
W:'$D(XBFIXPT("NOTALK")) !!,"Now checking false positives.",!
S U="^"
S XBFFILE=.99999999
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
W:'$D(XBFIXPT("NOTALK")) !!,"Now checking false negatives.",!
D FNEG
KILL XBFFILE,XBFL
W:'$D(XBFIXPT("NOTALK")) !!,"DONE",!
Q
;
FPOS ; CHECK FOR FALSE POSITIVES
S XBFPFILE=""
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
KILL XBFPFILE,XBFPFLD,XBFX
Q
;
CHKIT ;
W:'$D(XBFIXPT("NOTALK")) "."
I '$D(^DD(XBFPFILE)) W:'$D(XBFIXPT("NOTALK")) "|" KILL ^DD(XBFFILE,0,"PT",XBFPFILE) Q
; 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.
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.
S XBFX=$P(^DD(XBFPFILE,XBFPFLD,0),U,2)
I XBFX["P",XBFX[XBFFILE Q
I XBFX["V",$D(^DD(XBFPFILE,XBFPFLD,"V","B",XBFFILE)) Q
W:'$D(XBFIXPT("NOTALK")) "|"
KILL ^DD(XBFFILE,0,"PT",XBFPFILE,XBFPFLD)
Q
;
FNEG ; CHECK FOR FALSE NEGATIVES
S XBFFILE=.99999999
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
KILL XBFFILE,XBFFLD,XBFX,XBFI
Q
;
PTRCHK ;
S XBFX=$P(^DD(XBFFILE,XBFFLD,0),U,2)
I XBFX["V" D PTRCHK2 Q
Q:XBFX'["P"
F XBFI=1:1:$L(XBFX)+1 Q:$E(XBFX,XBFI)?1N
Q:XBFI>$L(XBFX)
S XBFX=$E(XBFX,XBFI,999),XBFX=+XBFX
Q:'XBFX
Q:XBFX<1 ;*** DOES NOT MESS WITH FILE NUMBERS < 1 ***
W:'$D(XBFIXPT("NOTALK")) "."
Q:'$D(^DIC(XBFX))
Q:'$D(^DD(XBFX,0))
I '$D(^DD(XBFX,0,"PT",XBFFILE,XBFFLD)) W "|" S ^(XBFFLD)=""
Q
;
PTRCHK2 ; VARIABLE POINTER CHECK
S XBFX=""
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)=""
Q
;
XBFIXPT ; IHS/ADC/GTH - FIX ALL "PT" NODES ; [ 11/04/97 10:26 AM ]
+1 ;;3.0;IHS/VA UTILITIES;**5**;FEB 07, 1997
+2 ; XB*3*5 IHS/ADC/GTH 10-31-97 Prevent UNDEF if ^DD entry incorrect.
+3 ;
+4 ; This routine fixes all "PT" nodes for files 1 through the
+5 ; highest file number in the current UCI.
+6 ;
START ;
+1 IF '$DATA(XBFIXPT("NOTALK"))
WRITE !!,"This routine insures the ""PT"" node of each FileMan file is correct.",!
+2 IF '$DATA(XBFIXPT("NOTALK"))
WRITE !!,"Now checking false positives.",!
+3 SET U="^"
+4 SET XBFFILE=.99999999
+5 FOR XBFL=0:0
SET XBFFILE=$ORDER(^DD(XBFFILE))
IF XBFFILE'=+XBFFILE
QUIT
IF $DATA(^DD(XBFFILE,0,"PT"))
IF '$DATA(XBFIXPT("NOTALK"))
WRITE !,XBFFILE
DO FPOS
+6 IF '$DATA(XBFIXPT("NOTALK"))
WRITE !!,"Now checking false negatives.",!
+7 DO FNEG
+8 KILL XBFFILE,XBFL
+9 IF '$DATA(XBFIXPT("NOTALK"))
WRITE !!,"DONE",!
+10 QUIT
+11 ;
FPOS ; CHECK FOR FALSE POSITIVES
+1 SET XBFPFILE=""
+2 FOR XBFL=0:0
SET XBFPFILE=$ORDER(^DD(XBFFILE,0,"PT",XBFPFILE))
IF XBFPFILE=""
QUIT
SET XBFPFLD=""
FOR XBFL=0:0
SET XBFPFLD=$ORDER(^DD(XBFFILE,0,"PT",XBFPFILE,XBFPFLD))
IF XBFPFLD=""
QUIT
DO CHKIT
+3 KILL XBFPFILE,XBFPFLD,XBFX
+4 QUIT
+5 ;
CHKIT ;
+1 IF '$DATA(XBFIXPT("NOTALK"))
WRITE "."
+2 IF '$DATA(^DD(XBFPFILE))
IF '$DATA(XBFIXPT("NOTALK"))
WRITE "|"
KILL ^DD(XBFFILE,0,"PT",XBFPFILE)
QUIT
+3 ; 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.
+4 ; XB*3*5 IHS/ADC/GTH 10-31-97 Prevent UNDEF if ^DD entry incorrect.
IF '$DATA(^DD(XBFPFILE,XBFPFLD,0))
IF '$DATA(XBFIXPT("NOTALK"))
WRITE "|"
KILL ^DD(XBFFILE,0,"PT",XBFPFILE,XBFPFLD)
QUIT
+5 SET XBFX=$PIECE(^DD(XBFPFILE,XBFPFLD,0),U,2)
+6 IF XBFX["P"
IF XBFX[XBFFILE
QUIT
+7 IF XBFX["V"
IF $DATA(^DD(XBFPFILE,XBFPFLD,"V","B",XBFFILE))
QUIT
+8 IF '$DATA(XBFIXPT("NOTALK"))
WRITE "|"
+9 KILL ^DD(XBFFILE,0,"PT",XBFPFILE,XBFPFLD)
+10 QUIT
+11 ;
FNEG ; CHECK FOR FALSE NEGATIVES
+1 SET XBFFILE=.99999999
+2 FOR XBFL=0:0
SET XBFFILE=$ORDER(^DD(XBFFILE))
IF XBFFILE'=+XBFFILE
QUIT
IF '$DATA(XBFIXPT("NOTALK"))
WRITE !,XBFFILE
SET XBFFLD=0
FOR XBFL=0:0
SET XBFFLD=$ORDER(^DD(XBFFILE,XBFFLD))
IF XBFFLD'=+XBFFLD
QUIT
IF $DATA(^(XBFFLD,0))#2
DO PTRCHK
+3 KILL XBFFILE,XBFFLD,XBFX,XBFI
+4 QUIT
+5 ;
PTRCHK ;
+1 SET XBFX=$PIECE(^DD(XBFFILE,XBFFLD,0),U,2)
+2 IF XBFX["V"
DO PTRCHK2
QUIT
+3 IF XBFX'["P"
QUIT
+4 FOR XBFI=1:1:$LENGTH(XBFX)+1
IF $EXTRACT(XBFX,XBFI)?1N
QUIT
+5 IF XBFI>$LENGTH(XBFX)
QUIT
+6 SET XBFX=$EXTRACT(XBFX,XBFI,999)
SET XBFX=+XBFX
+7 IF 'XBFX
QUIT
+8 ;*** DOES NOT MESS WITH FILE NUMBERS < 1 ***
IF XBFX<1
QUIT
+9 IF '$DATA(XBFIXPT("NOTALK"))
WRITE "."
+10 IF '$DATA(^DIC(XBFX))
QUIT
+11 IF '$DATA(^DD(XBFX,0))
QUIT
+12 IF '$DATA(^DD(XBFX,0,"PT",XBFFILE,XBFFLD))
WRITE "|"
SET ^(XBFFLD)=""
+13 QUIT
+14 ;
PTRCHK2 ; VARIABLE POINTER CHECK
+1 SET XBFX=""
+2 FOR XBFL=0:0
SET XBFX=$ORDER(^DD(XBFFILE,XBFFLD,"V","B",XBFX))
IF XBFX=""
QUIT
IF '$DATA(^DD(XBFX,0,"PT",XBFFILE,XBFFLD))
IF '$DATA(XBFIXPT("NOTALK"))
WRITE "|"
SET ^(XBFFLD)=""
+3 QUIT
+4 ;
