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