- DITMU4 ;SFISC/EDE(OHPRD)-FIX ALL "PT" NODES ;Jan 05, 2015
- ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- ;;Licensed under the terms of the Apache License, Version 2.0.
- ;
- ; This routine fixes all "PT" nodes for files 1 through the
- ; highest file number in the current UCI.
- ;
- START ;
- W:'$D(DITMU4("NOTALK")) !!,"This routine insures the ""PT"" node of each FileMan file is correct.",!
- W:'$D(DITMU4("NOTALK")) !!,"Now checking false positives.",!
- S U="^"
- S DITMU4FI=.99999999 F DITMU4L=0:0 S DITMU4FI=$O(^DD(DITMU4FI)) Q:DITMU4FI'=+DITMU4FI I $D(^DD(DITMU4FI,0,"PT")) W:'$D(DITMU4("NOTALK")) !,DITMU4FI D FPOS
- W:'$D(DITMU4("NOTALK")) !!,"Now checking false negatives.",!
- D FNEG
- K DITMU4FI,DITMU4L
- W:'$D(DITMU4("NOTALK")) !!,"DONE",!
- Q
- ;
- FPOS ; CHECK FOR FALSE POSITIVES
- S DITMU4PF="" F DITMU4L=0:0 S DITMU4PF=$O(^DD(DITMU4FI,0,"PT",DITMU4PF)) Q:DITMU4PF="" S DITMU4PD="" F DITMU4L=0:0 S DITMU4PD=$O(^DD(DITMU4FI,0,"PT",DITMU4PF,DITMU4PD)) Q:DITMU4PD="" D CHKIT
- K DITMU4PF,DITMU4PD,DITMU4X
- Q
- ;
- CHKIT ;
- W:'$D(DITMU4("NOTALK")) "."
- I '$D(^DD(DITMU4PF)) W:'$D(DITMU4("NOTALK")) "|" K ^DD(DITMU4FI,0,"PT",DITMU4PF) Q
- I '$D(^DD(DITMU4PF,DITMU4PD,0)) W:'$D(DITMU4("NOTALK")) "|" K ^DD(DITMU4FI,0,"PT",DITMU4PF,DITMU4PD) Q
- S DITMU4X=$P(^DD(DITMU4PF,DITMU4PD,0),U,2)
- I DITMU4X["P",DITMU4X[DITMU4FI Q
- I DITMU4X["V",$D(^DD(DITMU4PF,DITMU4PD,"V","B",DITMU4FI)) Q
- W:'$D(DITMU4("NOTALK")) "|" K ^DD(DITMU4FI,0,"PT",DITMU4PF,DITMU4PD)
- Q
- ;
- FNEG ; CHECK FOR FALSE NEGATIVES
- S DITMU4FI=.99999999 F DITMU4L=0:0 S DITMU4FI=$O(^DD(DITMU4FI)) Q:DITMU4FI'=+DITMU4FI W:'$D(DITMU4("NOTALK")) !,DITMU4FI S DITMU4FD=0 F DITMU4L=0:0 S DITMU4FD=$O(^DD(DITMU4FI,DITMU4FD)) Q:DITMU4FD'=+DITMU4FD D:$D(^(DITMU4FD,0))#2 PTRCHK
- K DITMU4FI,DITMU4FD,DITMU4X,DITMU4I
- Q
- ;
- PTRCHK ;
- S DITMU4X=$P(^(0),U,2)
- I DITMU4X["V" D PTRCHK2 Q
- Q:DITMU4X'["P"
- F DITMU4I=1:1:$L(DITMU4X)+1 Q:$E(DITMU4X,DITMU4I)?1N
- Q:DITMU4I>$L(DITMU4X)
- S DITMU4X=$E(DITMU4X,DITMU4I,999),DITMU4X=+DITMU4X
- Q:'DITMU4X
- Q:DITMU4X<1 ;*** DOES NOT MESS WITH FILE NUMBERS < 1 ***
- W:'$D(DITMU4("NOTALK")) "."
- Q:'$D(^DIC(DITMU4X))
- Q:'$D(^DD(DITMU4X,0))
- I '$D(^DD(DITMU4X,0,"PT",DITMU4FI,DITMU4FD)) W "|" S ^(DITMU4FD)=""
- Q
- ;
- PTRCHK2 ; VARIABLE POINTER CHECK
- S DITMU4X="" F DITMU4L=0:0 S DITMU4X=$O(^DD(DITMU4FI,DITMU4FD,"V","B",DITMU4X)) Q:DITMU4X="" I '$D(^DD(DITMU4X,0,"PT",DITMU4FI,DITMU4FD)) W:'$D(DITMU4("NOTALK")) "|" S ^(DITMU4FD)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDITMU4 2663 printed Mar 13, 2025@21:59:19 Page 2
- DITMU4 ;SFISC/EDE(OHPRD)-FIX ALL "PT" NODES ;Jan 05, 2015
- +1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- +4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- +5 ;;Licensed under the terms of the Apache License, Version 2.0.
- +6 ;
- +7 ; This routine fixes all "PT" nodes for files 1 through the
- +8 ; highest file number in the current UCI.
- +9 ;
- START ;
- +1 if '$DATA(DITMU4("NOTALK"))
- WRITE !!,"This routine insures the ""PT"" node of each FileMan file is correct.",!
- +2 if '$DATA(DITMU4("NOTALK"))
- WRITE !!,"Now checking false positives.",!
- +3 SET U="^"
- +4 SET DITMU4FI=.99999999
- FOR DITMU4L=0:0
- SET DITMU4FI=$ORDER(^DD(DITMU4FI))
- if DITMU4FI'=+DITMU4FI
- QUIT
- IF $DATA(^DD(DITMU4FI,0,"PT"))
- if '$DATA(DITMU4("NOTALK"))
- WRITE !,DITMU4FI
- DO FPOS
- +5 if '$DATA(DITMU4("NOTALK"))
- WRITE !!,"Now checking false negatives.",!
- +6 DO FNEG
- +7 KILL DITMU4FI,DITMU4L
- +8 if '$DATA(DITMU4("NOTALK"))
- WRITE !!,"DONE",!
- +9 QUIT
- +10 ;
- FPOS ; CHECK FOR FALSE POSITIVES
- +1 SET DITMU4PF=""
- FOR DITMU4L=0:0
- SET DITMU4PF=$ORDER(^DD(DITMU4FI,0,"PT",DITMU4PF))
- if DITMU4PF=""
- QUIT
- SET DITMU4PD=""
- FOR DITMU4L=0:0
- SET DITMU4PD=$ORDER(^DD(DITMU4FI,0,"PT",DITMU4PF,DITMU4PD))
- if DITMU4PD=""
- QUIT
- DO CHKIT
- +2 KILL DITMU4PF,DITMU4PD,DITMU4X
- +3 QUIT
- +4 ;
- CHKIT ;
- +1 if '$DATA(DITMU4("NOTALK"))
- WRITE "."
- +2 IF '$DATA(^DD(DITMU4PF))
- if '$DATA(DITMU4("NOTALK"))
- WRITE "|"
- KILL ^DD(DITMU4FI,0,"PT",DITMU4PF)
- QUIT
- +3 IF '$DATA(^DD(DITMU4PF,DITMU4PD,0))
- if '$DATA(DITMU4("NOTALK"))
- WRITE "|"
- KILL ^DD(DITMU4FI,0,"PT",DITMU4PF,DITMU4PD)
- QUIT
- +4 SET DITMU4X=$PIECE(^DD(DITMU4PF,DITMU4PD,0),U,2)
- +5 IF DITMU4X["P"
- IF DITMU4X[DITMU4FI
- QUIT
- +6 IF DITMU4X["V"
- IF $DATA(^DD(DITMU4PF,DITMU4PD,"V","B",DITMU4FI))
- QUIT
- +7 if '$DATA(DITMU4("NOTALK"))
- WRITE "|"
- KILL ^DD(DITMU4FI,0,"PT",DITMU4PF,DITMU4PD)
- +8 QUIT
- +9 ;
- FNEG ; CHECK FOR FALSE NEGATIVES
- +1 SET DITMU4FI=.99999999
- FOR DITMU4L=0:0
- SET DITMU4FI=$ORDER(^DD(DITMU4FI))
- if DITMU4FI'=+DITMU4FI
- QUIT
- if '$DATA(DITMU4("NOTALK"))
- WRITE !,DITMU4FI
- SET DITMU4FD=0
- FOR DITMU4L=0:0
- SET DITMU4FD=$ORDER(^DD(DITMU4FI,DITMU4FD))
- if DITMU4FD'=+DITMU4FD
- QUIT
- if $DATA(^(DITMU4FD,0))#2
- DO PTRCHK
- +2 KILL DITMU4FI,DITMU4FD,DITMU4X,DITMU4I
- +3 QUIT
- +4 ;
- PTRCHK ;
- +1 SET DITMU4X=$PIECE(^(0),U,2)
- +2 IF DITMU4X["V"
- DO PTRCHK2
- QUIT
- +3 if DITMU4X'["P"
- QUIT
- +4 FOR DITMU4I=1:1:$LENGTH(DITMU4X)+1
- if $EXTRACT(DITMU4X,DITMU4I)?1N
- QUIT
- +5 if DITMU4I>$LENGTH(DITMU4X)
- QUIT
- +6 SET DITMU4X=$EXTRACT(DITMU4X,DITMU4I,999)
- SET DITMU4X=+DITMU4X
- +7 if 'DITMU4X
- QUIT
- +8 ;*** DOES NOT MESS WITH FILE NUMBERS < 1 ***
- if DITMU4X<1
- QUIT
- +9 if '$DATA(DITMU4("NOTALK"))
- WRITE "."
- +10 if '$DATA(^DIC(DITMU4X))
- QUIT
- +11 if '$DATA(^DD(DITMU4X,0))
- QUIT
- +12 IF '$DATA(^DD(DITMU4X,0,"PT",DITMU4FI,DITMU4FD))
- WRITE "|"
- SET ^(DITMU4FD)=""
- +13 QUIT
- +14 ;
- PTRCHK2 ; VARIABLE POINTER CHECK
- +1 SET DITMU4X=""
- FOR DITMU4L=0:0
- SET DITMU4X=$ORDER(^DD(DITMU4FI,DITMU4FD,"V","B",DITMU4X))
- if DITMU4X=""
- QUIT
- IF '$DATA(^DD(DITMU4X,0,"PT",DITMU4FI,DITMU4FD))
- if '$DATA(DITMU4("NOTALK"))
- WRITE "|"
- SET ^(DITMU4FD)=""
- +2 QUIT
