XBCDIC3 ; IHS/ADC/GTH - CHECK ^DD ; [ 02/07/97 3:02 PM ]
;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
;
; Part of XBCDIC
;
START ;
W !!,"Now checking ^DD entries."
S U="^",XBCDFILE=""
F XBCDL=0:0 S XBCDFILE=$O(^UTILITY("XBDSET",$J,XBCDFILE)) Q:XBCDFILE="" W !?5,"Checking ",XBCDFILE D XBCDDDC
KILL XBCDANS,XBCDFILE,XBCDL
Q
;
XBCDDDC ; CHECK ^DD ENTRY
D CHKDD0 ; CHECK ^DD 0TH NODE
D CHKPT ; CHECK "PT" NODE
D CHKTRB ; CHECK "TRB" NODE
D CHKACOMP ; CHECK "ACOMP" NODE
D SBTRACE ; CHECK "SB" NODE
Q
;
CHKDD0 ; CHECK 0TH NODE
I '($D(^DD(XBCDFILE,.01,0))#2) W !,"File ",XBCDFILE," has no ^DD(",XBCDFILE,",.01,0) entry."
I '$D(^DD(XBCDFILE,0,"NM")) W !,"File ",XBCDFILE," has no ^DD(",XBCDFILE,",0,""NM"") entry."
E S XBCDX=$O(^DD(XBCDFILE,0,"NM","")),XBCDX=$O(^(XBCDX)) I XBCDX]"" W !,"File ",XBCDFILE," has multiple names."
Q
;
CHKPT ; CHECK "PT" NODE
S XBCDPFLE=""
F XBCDL=0:0 S XBCDPFLE=$O(^DD(XBCDFILE,0,"PT",XBCDPFLE)) Q:XBCDPFLE="" S XBCDPFLD="" F XBCDL=0:0 S XBCDPFLD=$O(^DD(XBCDFILE,0,"PT",XBCDPFLE,XBCDPFLD)) Q:XBCDPFLD="" D PT
KILL XBCDPFLE,XBCDPFLD,XBCDX
Q
PT ;
W "."
I '$D(^DD(XBCDPFLE)) W "|" KILL ^DD(XBCDFILE,0,"PT",XBCDPFLE) Q
I '$D(^DD(XBCDPFLE,XBCDPFLD)) W "|" KILL ^DD(XBCDFILE,0,"PT",XBCDPFLE,XBCDPFLD) Q
S XBCDX=$P(^DD(XBCDPFLE,XBCDPFLD,0),U,2)
I XBCDX["V",$D(^DD(XBCDPFLE,XBCDPFLD,"V","B",XBCDFILE)) Q
I XBCDX["P",XBCDX[XBCDFILE Q
W "|" KILL ^DD(XBCDFILE,0,"PT",XBCDPFLE,XBCDPFLD)
Q
;
CHKTRB ; CHECK "TRB" NODE
Q:'$D(^DD(XBCDFILE,"TRB"))
S XBCDTFLE=""
F XBCDL=0:0 S XBCDTFLE=$O(^DD(XBCDFILE,"TRB",XBCDTFLE)) Q:XBCDTFLE="" S XBCDTFLD="" F XBCDL=0:0 S XBCDTFLD=$O(^DD(XBCDFILE,"TRB",XBCDTFLE,XBCDTFLD)) Q:XBCDTFLD="" D TRB
KILL XBCDTFLE,XBCDTFLD,XBCDX
Q
;
TRB ; THIS CAN CHECK MORE THAN IT DOES ***
W "."
I '$D(^DD(XBCDTFLE)) W "|" KILL ^DD(XBCDFILE,"TRB",XBCDTFLE) Q
I '$D(^DD(XBCDTFLE,XBCDTFLD)) W "|" KILL ^DD(XBCDFILE,"TRB",XBCDTFLE,XBCDTFLD) Q
Q
;
CHKACOMP ; CHECK "ACOMP" ENTRIES
Q:'$D(^DD("ACOMP",XBCDFILE))
S XBCDFLD=""
F XBCDL=0:0 S XBCDFLD=$O(^DD("ACOMP",XBCDFILE,XBCDFLD)) Q:XBCDFLD'=+XBCDFLD D CHKFIELD
KILL XBCDFLD
Q
;
CHKFIELD ;
S XBCDAFLE=""
F XBCDL=0:0 S XBCDAFLE=$O(^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE)) Q:XBCDAFLE="" S XBCDAFLD="" F XBCDL=0:0 S XBCDAFLD=$O(^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE,XBCDAFLD)) Q:XBCDAFLD="" D ACOMP
KILL XBCDAFLE,XBCDAFLD,XBCDX
Q
;
ACOMP ;
W "."
I '$D(^DD(XBCDAFLE)) W "|" KILL ^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE) Q
I '$D(^DD(XBCDAFLE,XBCDAFLD)) W "|" KILL ^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE,XBCDAFLD) Q
I '($D(^DD(XBCDAFLE,XBCDAFLD,0))#2) W "|" KILL ^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE,XBCDAFLD) Q
S XBCDX=$P(^DD(XBCDAFLE,XBCDAFLD,0),U,2)
I XBCDX'["C" W "|" KILL ^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE,XBCDAFLD)
Q
;
SBTRACE ; CHECK ALL SUB-FILES
KILL XBCDSFL
S XBCDC=1,XBCDSFL="",XBCDSFL(XBCDC)=XBCDFILE
F XBCDL=0:0 S XBCDI=$O(XBCDSFL("")) Q:XBCDI="" S XBCDSF=XBCDSFL(XBCDI) D SBTRACE2 S XBCDI=$O(XBCDSFL("")) W "." KILL XBCDSFL(XBCDI)
KILL XBCDC,XBCDI,XBCDSF,XBCDSFL,XBCDY,XBCDZ
Q
;
SBTRACE2 ;
S XBCDI=0
F XBCDL=0:0 S XBCDI=$O(^DD(XBCDSF,"SB",XBCDI)) Q:XBCDI="" W "." S XBCDC=XBCDC+1,XBCDSFL(XBCDC)=XBCDI D SBCHECK
Q
;
SBCHECK ;
I '$D(^DD(XBCDI)) S X=$O(^DD(XBCDSF,"SB",XBCDI,0)),Y=$P(^DD(XBCDSF,X,0),U) D Q
. W !?10,"Subfile ",XBCDI," for field ",X," does not exists.",!?12,"Deleting field ",X," from file ",XBCDSF
. KILL ^DD(XBCDSF,X),^DD(XBCDSF,"SB",XBCDI),^DD(XBCDSF,"B",Y,X)
. Q
D SBTRACE3,SBTRACE4
Q
;
SBTRACE3 ;
I '$D(^DD(XBCDI,0,"UP")),$D(^DIC(XBCDI)) W !?10,XBCDI," is a primary file. Deleting ^DD(",XBCDSF,",""SB"",",XBCDI,")" KILL ^DD(XBCDSF,"SB",XBCDI) Q
I $D(^DD(XBCDI,0,"PT")) W !?10,XBCDI," sub-file has ""PT"" node. Deleting." KILL ^DD(XBCDI,0,"PT")
I '$D(^DD(XBCDI,0,"UP")) W !?10,XBCDI," has no ""UP"" node. Creating ^DD(",XBCDI,",0,""UP"")=",XBCDSF S ^DD(XBCDI,0,"UP")=XBCDSF
Q:^DD(XBCDI,0,"UP")=XBCDSF
I ^DD(XBCDI,0,"UP")="" W !?10,XBCDI," ""UP"" node is NULL. Setting ^DD(",XBCDI,",0,""UP"")=",XBCDSF S ^DD(XBCDI,0,"UP")=XBCDSF Q
W !?10,XBCDSF," lists ",XBCDI," as a sub-file. The ""UP"" node in ",!?10+$L(XBCDSF)+1,XBCDI," is ",^DD(XBCDI,0,"UP"),"."
I $D(^DD(^DD(XBCDI,0,"UP"),"SB",XBCDSF)) W !?12,"The ""SB"" in ",^DD(XBCDI,0,"UP")," agrees. Fixing." KILL ^DD(XBCDSF,"SB",XBCDI) Q
E W !?12,"The ""SB"" in ",^DD(XBCDI,0,"UP")," disagrees. Fixing." S ^DD(XBCDI,0,"UP")=XBCDSF
Q
;
SBTRACE4 ;
I '$D(^DD(XBCDI,0,"NM")) W !?10,"Sub-file ",XBCDI," has no ^DD(",XBCDI,",0,""NM"") entry. Fixing." D SBTFIX I 1
E S XBCDX=$O(^DD(XBCDI,0,"NM","")),XBCDX=$O(^(XBCDX)) I XBCDX]"" W !?10,"Sub-file ",XBCDI," has multiple names. Fixing." D SBTFIX
Q
;
SBTFIX ; FIX "NM"
KILL ^DD(XBCDI,0,"NM")
I '$D(^DD(XBCDI,0,"UP")) W !?12,"Can't fix. No ""UP"" node." Q
S XBCDX=^DD(XBCDI,0,"UP")
I XBCDX="" W !?12,"Can't fix. ""UP"" node is NULL." Q
I '$D(^DD(XBCDX,"SB",XBCDI)) W !?12,"Can't fix because can't locate parent field." Q
S XBCDY=$O(^DD(XBCDX,"SB",XBCDI,"")),XBCDZ=$P(^DD(XBCDX,XBCDY,0),U,1)
S ^DD(XBCDI,0,"NM",XBCDZ)=""
Q
;
XBCDIC3 ; IHS/ADC/GTH - CHECK ^DD ; [ 02/07/97 3:02 PM ]
+1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
+2 ;
+3 ; Part of XBCDIC
+4 ;
START ;
+1 WRITE !!,"Now checking ^DD entries."
+2 SET U="^"
SET XBCDFILE=""
+3 FOR XBCDL=0:0
SET XBCDFILE=$ORDER(^UTILITY("XBDSET",$JOB,XBCDFILE))
IF XBCDFILE=""
QUIT
WRITE !?5,"Checking ",XBCDFILE
DO XBCDDDC
+4 KILL XBCDANS,XBCDFILE,XBCDL
+5 QUIT
+6 ;
XBCDDDC ; CHECK ^DD ENTRY
+1 ; CHECK ^DD 0TH NODE
DO CHKDD0
+2 ; CHECK "PT" NODE
DO CHKPT
+3 ; CHECK "TRB" NODE
DO CHKTRB
+4 ; CHECK "ACOMP" NODE
DO CHKACOMP
+5 ; CHECK "SB" NODE
DO SBTRACE
+6 QUIT
+7 ;
CHKDD0 ; CHECK 0TH NODE
+1 IF '($DATA(^DD(XBCDFILE,.01,0))#2)
WRITE !,"File ",XBCDFILE," has no ^DD(",XBCDFILE,",.01,0) entry."
+2 IF '$DATA(^DD(XBCDFILE,0,"NM"))
WRITE !,"File ",XBCDFILE," has no ^DD(",XBCDFILE,",0,""NM"") entry."
+3 IF '$TEST
SET XBCDX=$ORDER(^DD(XBCDFILE,0,"NM",""))
SET XBCDX=$ORDER(^(XBCDX))
IF XBCDX]""
WRITE !,"File ",XBCDFILE," has multiple names."
+4 QUIT
+5 ;
CHKPT ; CHECK "PT" NODE
+1 SET XBCDPFLE=""
+2 FOR XBCDL=0:0
SET XBCDPFLE=$ORDER(^DD(XBCDFILE,0,"PT",XBCDPFLE))
IF XBCDPFLE=""
QUIT
SET XBCDPFLD=""
FOR XBCDL=0:0
SET XBCDPFLD=$ORDER(^DD(XBCDFILE,0,"PT",XBCDPFLE,XBCDPFLD))
IF XBCDPFLD=""
QUIT
DO PT
+3 KILL XBCDPFLE,XBCDPFLD,XBCDX
+4 QUIT
PT ;
+1 WRITE "."
+2 IF '$DATA(^DD(XBCDPFLE))
WRITE "|"
KILL ^DD(XBCDFILE,0,"PT",XBCDPFLE)
QUIT
+3 IF '$DATA(^DD(XBCDPFLE,XBCDPFLD))
WRITE "|"
KILL ^DD(XBCDFILE,0,"PT",XBCDPFLE,XBCDPFLD)
QUIT
+4 SET XBCDX=$PIECE(^DD(XBCDPFLE,XBCDPFLD,0),U,2)
+5 IF XBCDX["V"
IF $DATA(^DD(XBCDPFLE,XBCDPFLD,"V","B",XBCDFILE))
QUIT
+6 IF XBCDX["P"
IF XBCDX[XBCDFILE
QUIT
+7 WRITE "|"
KILL ^DD(XBCDFILE,0,"PT",XBCDPFLE,XBCDPFLD)
+8 QUIT
+9 ;
CHKTRB ; CHECK "TRB" NODE
+1 IF '$DATA(^DD(XBCDFILE,"TRB"))
QUIT
+2 SET XBCDTFLE=""
+3 FOR XBCDL=0:0
SET XBCDTFLE=$ORDER(^DD(XBCDFILE,"TRB",XBCDTFLE))
IF XBCDTFLE=""
QUIT
SET XBCDTFLD=""
FOR XBCDL=0:0
SET XBCDTFLD=$ORDER(^DD(XBCDFILE,"TRB",XBCDTFLE,XBCDTFLD))
IF XBCDTFLD=""
QUIT
DO TRB
+4 KILL XBCDTFLE,XBCDTFLD,XBCDX
+5 QUIT
+6 ;
TRB ; THIS CAN CHECK MORE THAN IT DOES ***
+1 WRITE "."
+2 IF '$DATA(^DD(XBCDTFLE))
WRITE "|"
KILL ^DD(XBCDFILE,"TRB",XBCDTFLE)
QUIT
+3 IF '$DATA(^DD(XBCDTFLE,XBCDTFLD))
WRITE "|"
KILL ^DD(XBCDFILE,"TRB",XBCDTFLE,XBCDTFLD)
QUIT
+4 QUIT
+5 ;
CHKACOMP ; CHECK "ACOMP" ENTRIES
+1 IF '$DATA(^DD("ACOMP",XBCDFILE))
QUIT
+2 SET XBCDFLD=""
+3 FOR XBCDL=0:0
SET XBCDFLD=$ORDER(^DD("ACOMP",XBCDFILE,XBCDFLD))
IF XBCDFLD'=+XBCDFLD
QUIT
DO CHKFIELD
+4 KILL XBCDFLD
+5 QUIT
+6 ;
CHKFIELD ;
+1 SET XBCDAFLE=""
+2 FOR XBCDL=0:0
SET XBCDAFLE=$ORDER(^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE))
IF XBCDAFLE=""
QUIT
SET XBCDAFLD=""
FOR XBCDL=0:0
SET XBCDAFLD=$ORDER(^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE,XBCDAFLD))
IF XBCDAFLD=""
QUIT
DO ACOMP
+3 KILL XBCDAFLE,XBCDAFLD,XBCDX
+4 QUIT
+5 ;
ACOMP ;
+1 WRITE "."
+2 IF '$DATA(^DD(XBCDAFLE))
WRITE "|"
KILL ^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE)
QUIT
+3 IF '$DATA(^DD(XBCDAFLE,XBCDAFLD))
WRITE "|"
KILL ^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE,XBCDAFLD)
QUIT
+4 IF '($DATA(^DD(XBCDAFLE,XBCDAFLD,0))#2)
WRITE "|"
KILL ^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE,XBCDAFLD)
QUIT
+5 SET XBCDX=$PIECE(^DD(XBCDAFLE,XBCDAFLD,0),U,2)
+6 IF XBCDX'["C"
WRITE "|"
KILL ^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE,XBCDAFLD)
+7 QUIT
+8 ;
SBTRACE ; CHECK ALL SUB-FILES
+1 KILL XBCDSFL
+2 SET XBCDC=1
SET XBCDSFL=""
SET XBCDSFL(XBCDC)=XBCDFILE
+3 FOR XBCDL=0:0
SET XBCDI=$ORDER(XBCDSFL(""))
IF XBCDI=""
QUIT
SET XBCDSF=XBCDSFL(XBCDI)
DO SBTRACE2
SET XBCDI=$ORDER(XBCDSFL(""))
WRITE "."
KILL XBCDSFL(XBCDI)
+4 KILL XBCDC,XBCDI,XBCDSF,XBCDSFL,XBCDY,XBCDZ
+5 QUIT
+6 ;
SBTRACE2 ;
+1 SET XBCDI=0
+2 FOR XBCDL=0:0
SET XBCDI=$ORDER(^DD(XBCDSF,"SB",XBCDI))
IF XBCDI=""
QUIT
WRITE "."
SET XBCDC=XBCDC+1
SET XBCDSFL(XBCDC)=XBCDI
DO SBCHECK
+3 QUIT
+4 ;
SBCHECK ;
+1 IF '$DATA(^DD(XBCDI))
SET X=$ORDER(^DD(XBCDSF,"SB",XBCDI,0))
SET Y=$PIECE(^DD(XBCDSF,X,0),U)
Begin DoDot:1
+2 WRITE !?10,"Subfile ",XBCDI," for field ",X," does not exists.",!?12,"Deleting field ",X," from file ",XBCDSF
+3 KILL ^DD(XBCDSF,X),^DD(XBCDSF,"SB",XBCDI),^DD(XBCDSF,"B",Y,X)
+4 QUIT
End DoDot:1
QUIT
+5 DO SBTRACE3
DO SBTRACE4
+6 QUIT
+7 ;
SBTRACE3 ;
+1 IF '$DATA(^DD(XBCDI,0,"UP"))
IF $DATA(^DIC(XBCDI))
WRITE !?10,XBCDI," is a primary file. Deleting ^DD(",XBCDSF,",""SB"",",XBCDI,")"
KILL ^DD(XBCDSF,"SB",XBCDI)
QUIT
+2 IF $DATA(^DD(XBCDI,0,"PT"))
WRITE !?10,XBCDI," sub-file has ""PT"" node. Deleting."
KILL ^DD(XBCDI,0,"PT")
+3 IF '$DATA(^DD(XBCDI,0,"UP"))
WRITE !?10,XBCDI," has no ""UP"" node. Creating ^DD(",XBCDI,",0,""UP"")=",XBCDSF
SET ^DD(XBCDI,0,"UP")=XBCDSF
+4 IF ^DD(XBCDI,0,"UP")=XBCDSF
QUIT
+5 IF ^DD(XBCDI,0,"UP")=""
WRITE !?10,XBCDI," ""UP"" node is NULL. Setting ^DD(",XBCDI,",0,""UP"")=",XBCDSF
SET ^DD(XBCDI,0,"UP")=XBCDSF
QUIT
+6 WRITE !?10,XBCDSF," lists ",XBCDI," as a sub-file. The ""UP"" node in ",!?10+$LENGTH(XBCDSF)+1,XBCDI," is ",^DD(XBCDI,0,"UP"),"."
+7 IF $DATA(^DD(^DD(XBCDI,0,"UP"),"SB",XBCDSF))
WRITE !?12,"The ""SB"" in ",^DD(XBCDI,0,"UP")," agrees. Fixing."
KILL ^DD(XBCDSF,"SB",XBCDI)
QUIT
+8 IF '$TEST
WRITE !?12,"The ""SB"" in ",^DD(XBCDI,0,"UP")," disagrees. Fixing."
SET ^DD(XBCDI,0,"UP")=XBCDSF
+9 QUIT
+10 ;
SBTRACE4 ;
+1 IF '$DATA(^DD(XBCDI,0,"NM"))
WRITE !?10,"Sub-file ",XBCDI," has no ^DD(",XBCDI,",0,""NM"") entry. Fixing."
DO SBTFIX
IF 1
+2 IF '$TEST
SET XBCDX=$ORDER(^DD(XBCDI,0,"NM",""))
SET XBCDX=$ORDER(^(XBCDX))
IF XBCDX]""
WRITE !?10,"Sub-file ",XBCDI," has multiple names. Fixing."
DO SBTFIX
+3 QUIT
+4 ;
SBTFIX ; FIX "NM"
+1 KILL ^DD(XBCDI,0,"NM")
+2 IF '$DATA(^DD(XBCDI,0,"UP"))
WRITE !?12,"Can't fix. No ""UP"" node."
QUIT
+3 SET XBCDX=^DD(XBCDI,0,"UP")
+4 IF XBCDX=""
WRITE !?12,"Can't fix. ""UP"" node is NULL."
QUIT
+5 IF '$DATA(^DD(XBCDX,"SB",XBCDI))
WRITE !?12,"Can't fix because can't locate parent field."
QUIT
+6 SET XBCDY=$ORDER(^DD(XBCDX,"SB",XBCDI,""))
SET XBCDZ=$PIECE(^DD(XBCDX,XBCDY,0),U,1)
+7 SET ^DD(XBCDI,0,"NM",XBCDZ)=""
+8 QUIT
+9 ;
