AUCDIC3 ; CHECK ^DD [ 11/29/87 2:11 PM ]
;
S U="^"
W !!,"Now checking ^DD entries." S AUCDFILE="" F AUCDL=0:0 S AUCDFILE=$O(^UTILITY("AUDSET",$J,AUCDFILE)) Q:AUCDFILE="" W !,?5,"Checking ",AUCDFILE D AUCDDDC
K AUCDANS,AUCDFILE,AUCDL
Q
;
AUCDDDC ; 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(AUCDFILE,.01,0))#2) W !,"File "_AUCDFILE_" has no ^DD("_AUCDFILE_",.01,0) entry."
I '$D(^DD(AUCDFILE,0,"NM")) W !,"File "_AUCDFILE_" has no ^DD("_AUCDFILE_",0,""NM"") entry."
E S AUCDX=$O(^("NM","")),AUCDX=$O(^(AUCDX)) I AUCDX'="" W !,"File "_AUCDFILE_" has multiple names."
Q
;
CHKPT ; CHECK "PT" NODE
S AUCDPFLE="" F AUCDL=0:0 S AUCDPFLE=$O(^DD(AUCDFILE,0,"PT",AUCDPFLE)) Q:AUCDPFLE="" S AUCDPFLD="" F AUCDL=0:0 S AUCDPFLD=$O(^DD(AUCDFILE,0,"PT",AUCDPFLE,AUCDPFLD)) Q:AUCDPFLD="" D PT
K AUCDPFLE,AUCDPFLD,AUCDX
Q
PT ;
W "."
I '$D(^DD(AUCDPFLE)) W "|" K ^DD(AUCDFILE,0,"PT",AUCDPFLE) Q
I '$D(^DD(AUCDPFLE,AUCDPFLD)) W "|" K ^DD(AUCDFILE,0,"PT",AUCDPFLE,AUCDPFLD) Q
S AUCDX=$P(^DD(AUCDPFLE,AUCDPFLD,0),U,2)
I AUCDX["V",$D(^DD(AUCDPFLE,AUCDPFLD,"V","B",AUCDFILE)) Q
I AUCDX["P",AUCDX[AUCDFILE Q
W "|" K ^DD(AUCDFILE,0,"PT",AUCDPFLE,AUCDPFLD)
Q
;
CHKTRB ; CHECK "TRB" NODE
Q:'$D(^DD(AUCDFILE,"TRB"))
S AUCDTFLE="" F AUCDL=0:0 S AUCDTFLE=$O(^DD(AUCDFILE,"TRB",AUCDTFLE)) Q:AUCDTFLE="" S AUCDTFLD="" F AUCDL=0:0 S AUCDTFLD=$O(^DD(AUCDFILE,"TRB",AUCDTFLE,AUCDTFLD)) Q:AUCDTFLD="" D TRB
K AUCDTFLE,AUCDTFLD,AUCDX
Q
TRB ;
; THIS CAN CHECK MORE THAN IT DOES ***
W "."
I '$D(^DD(AUCDTFLE)) W "|" K ^DD(AUCDFILE,"TRB",AUCDTFLE) Q
I '$D(^DD(AUCDTFLE,AUCDTFLD)) W "|" K ^DD(AUCDFILE,"TRB",AUCDTFLE,AUCDTFLD) Q
Q
;
CHKACOMP ; CHECK "ACOMP" ENTRIES
Q:'$D(^DD("ACOMP",AUCDFILE))
S AUCDFLD="" F AUCDL=0:0 S AUCDFLD=$O(^DD("ACOMP",AUCDFILE,AUCDFLD)) Q:AUCDFLD'=+AUCDFLD D CHKFIELD
K AUCDFLD
Q
CHKFIELD S AUCDAFLE="" F AUCDL=0:0 S AUCDAFLE=$O(^DD("ACOMP",AUCDFILE,AUCDFLD,AUCDAFLE)) Q:AUCDAFLE="" S AUCDAFLD="" F AUCDL=0:0 S AUCDAFLD=$O(^DD("ACOMP",AUCDFILE,AUCDFLD,AUCDAFLE,AUCDAFLD)) Q:AUCDAFLD="" D ACOMP
K AUCDAFLE,AUCDAFLD,AUCDX
Q
ACOMP ;
W "."
I '$D(^DD(AUCDAFLE)) W "|" K ^DD("ACOMP",AUCDFILE,AUCDFLD,AUCDAFLE) Q
I '$D(^DD(AUCDAFLE,AUCDAFLD)) W "|" K ^DD("ACOMP",AUCDFILE,AUCDFLD,AUCDAFLE,AUCDAFLD) Q
I '($D(^DD(AUCDAFLE,AUCDAFLD,0))#2) W "|" K ^DD("ACOMP",AUCDFILE,AUCDFLD,AUCDAFLE,AUCDAFLD) Q
S AUCDX=$P(^DD(AUCDAFLE,AUCDAFLD,0),U,2)
I AUCDX'["C" W "|" K ^DD("ACOMP",AUCDFILE,AUCDFLD,AUCDAFLE,AUCDAFLD)
Q
;
SBTRACE ; CHECK ALL SUB-FILES
K AUCDSFL S AUCDC=1,AUCDSFL="",AUCDSFL(AUCDC)=AUCDFILE
F AUCDL=0:0 S AUCDI=$O(AUCDSFL("")) Q:AUCDI="" S AUCDSF=AUCDSFL(AUCDI) D SBTRACE2 S AUCDI=$O(AUCDSFL("")) W "." K AUCDSFL(AUCDI)
K AUCDC,AUCDI,AUCDSF,AUCDSFL,AUCDY,AUCDZ
Q
SBTRACE2 ;
S AUCDI=0 F AUCDL=0:0 S AUCDI=$O(^DD(AUCDSF,"SB",AUCDI)) Q:AUCDI="" W "." S AUCDC=AUCDC+1,AUCDSFL(AUCDC)=AUCDI D SBTRACE3,SBTRACE4
Q
SBTRACE3 ;
I '$D(^DD(AUCDI,0,"UP")),$D(^DIC(AUCDI)) W !,?10,AUCDI," is a primary file. Deleting ^DD(",AUCDSF,",""SB"",",AUCDI,")" K ^DD(AUCDSF,"SB",AUCDI) Q
I $D(^DD(AUCDI,0,"PT")) W !,?10,AUCDI," sub-file has ""PT"" node. Deleting." K ^DD(AUCDI,0,"PT")
I '$D(^DD(AUCDI,0,"UP")) W !,?10,AUCDI," has no ""UP"" node. Creating ^DD(",AUCDI,",0,""UP"")=",AUCDSF S ^DD(AUCDI,0,"UP")=AUCDSF
Q:^DD(AUCDI,0,"UP")=AUCDSF
I ^DD(AUCDI,0,"UP")="" W !,?10,AUCDI," ""UP"" node is NULL. Setting ^DD(",AUCDI,",0,""UP"")=",AUCDSF S ^DD(AUCDI,0,"UP")=AUCDSF Q
W !,?10,AUCDSF," lists ",AUCDI," as a sub-file. The ""UP"" node in ",!,?10+$L(AUCDSF)+1,AUCDI," is ",^DD(AUCDI,0,"UP"),"."
I $D(^DD(^DD(AUCDI,0,"UP"),"SB",AUCDSF)) W !,?12,"The ""SB"" in ",^DD(AUCDI,0,"UP")," agrees. Fixing." K ^DD(AUCDSF,"SB",AUCDI) Q
E W !,?12,"The ""SB"" in ",^DD(AUCDI,0,"UP")," disagrees. Fixing." S ^DD(AUCDI,0,"UP")=AUCDSF
Q
SBTRACE4 ;
I '$D(^DD(AUCDI,0,"NM")) W !,?10,"Sub-file "_AUCDI_" has no ^DD("_AUCDI_",0,""NM"") entry. Fixing." D SBTFIX
E S AUCDX=$O(^("NM","")),AUCDX=$O(^(AUCDX)) I AUCDX'="" W !,?10,"Sub-file "_AUCDI_" has multiple names. Fixing." D SBTFIX
Q
SBTFIX ; FIX "NM"
K ^DD(AUCDI,0,"NM")
I '$D(^DD(AUCDI,0,"UP")) W !,?12,"Can't fix. No ""UP"" node." Q
S AUCDX=^("UP")
I AUCDX="" W !,?12,"Can't fix. ""UP"" node is NULL." Q
I '$D(^DD(AUCDX,"SB",AUCDI)) W !,?12,"Can't fix because can't locate parent field." Q
S AUCDY=$O(^(AUCDI,"")),AUCDZ=$P(^DD(AUCDX,AUCDY,0),U,1)
S ^DD(AUCDI,0,"NM",AUCDZ)=""
Q
AUCDIC3 ; CHECK ^DD [ 11/29/87 2:11 PM ]
+1 ;
+2 SET U="^"
+3 WRITE !!,"Now checking ^DD entries."
SET AUCDFILE=""
FOR AUCDL=0:0
SET AUCDFILE=$ORDER(^UTILITY("AUDSET",$JOB,AUCDFILE))
IF AUCDFILE=""
QUIT
WRITE !,?5,"Checking ",AUCDFILE
DO AUCDDDC
+4 KILL AUCDANS,AUCDFILE,AUCDL
+5 QUIT
+6 ;
AUCDDDC ; 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(AUCDFILE,.01,0))#2)
WRITE !,"File "_AUCDFILE_" has no ^DD("_AUCDFILE_",.01,0) entry."
+2 IF '$DATA(^DD(AUCDFILE,0,"NM"))
WRITE !,"File "_AUCDFILE_" has no ^DD("_AUCDFILE_",0,""NM"") entry."
+3 IF '$TEST
SET AUCDX=$ORDER(^("NM",""))
SET AUCDX=$ORDER(^(AUCDX))
IF AUCDX'=""
WRITE !,"File "_AUCDFILE_" has multiple names."
+4 QUIT
+5 ;
CHKPT ; CHECK "PT" NODE
+1 SET AUCDPFLE=""
FOR AUCDL=0:0
SET AUCDPFLE=$ORDER(^DD(AUCDFILE,0,"PT",AUCDPFLE))
IF AUCDPFLE=""
QUIT
SET AUCDPFLD=""
FOR AUCDL=0:0
SET AUCDPFLD=$ORDER(^DD(AUCDFILE,0,"PT",AUCDPFLE,AUCDPFLD))
IF AUCDPFLD=""
QUIT
DO PT
+2 KILL AUCDPFLE,AUCDPFLD,AUCDX
+3 QUIT
PT ;
+1 WRITE "."
+2 IF '$DATA(^DD(AUCDPFLE))
WRITE "|"
KILL ^DD(AUCDFILE,0,"PT",AUCDPFLE)
QUIT
+3 IF '$DATA(^DD(AUCDPFLE,AUCDPFLD))
WRITE "|"
KILL ^DD(AUCDFILE,0,"PT",AUCDPFLE,AUCDPFLD)
QUIT
+4 SET AUCDX=$PIECE(^DD(AUCDPFLE,AUCDPFLD,0),U,2)
+5 IF AUCDX["V"
IF $DATA(^DD(AUCDPFLE,AUCDPFLD,"V","B",AUCDFILE))
QUIT
+6 IF AUCDX["P"
IF AUCDX[AUCDFILE
QUIT
+7 WRITE "|"
KILL ^DD(AUCDFILE,0,"PT",AUCDPFLE,AUCDPFLD)
+8 QUIT
+9 ;
CHKTRB ; CHECK "TRB" NODE
+1 IF '$DATA(^DD(AUCDFILE,"TRB"))
QUIT
+2 SET AUCDTFLE=""
FOR AUCDL=0:0
SET AUCDTFLE=$ORDER(^DD(AUCDFILE,"TRB",AUCDTFLE))
IF AUCDTFLE=""
QUIT
SET AUCDTFLD=""
FOR AUCDL=0:0
SET AUCDTFLD=$ORDER(^DD(AUCDFILE,"TRB",AUCDTFLE,AUCDTFLD))
IF AUCDTFLD=""
QUIT
DO TRB
+3 KILL AUCDTFLE,AUCDTFLD,AUCDX
+4 QUIT
TRB ;
+1 ; THIS CAN CHECK MORE THAN IT DOES ***
+2 WRITE "."
+3 IF '$DATA(^DD(AUCDTFLE))
WRITE "|"
KILL ^DD(AUCDFILE,"TRB",AUCDTFLE)
QUIT
+4 IF '$DATA(^DD(AUCDTFLE,AUCDTFLD))
WRITE "|"
KILL ^DD(AUCDFILE,"TRB",AUCDTFLE,AUCDTFLD)
QUIT
+5 QUIT
+6 ;
CHKACOMP ; CHECK "ACOMP" ENTRIES
+1 IF '$DATA(^DD("ACOMP",AUCDFILE))
QUIT
+2 SET AUCDFLD=""
FOR AUCDL=0:0
SET AUCDFLD=$ORDER(^DD("ACOMP",AUCDFILE,AUCDFLD))
IF AUCDFLD'=+AUCDFLD
QUIT
DO CHKFIELD
+3 KILL AUCDFLD
+4 QUIT
CHKFIELD SET AUCDAFLE=""
FOR AUCDL=0:0
SET AUCDAFLE=$ORDER(^DD("ACOMP",AUCDFILE,AUCDFLD,AUCDAFLE))
IF AUCDAFLE=""
QUIT
SET AUCDAFLD=""
FOR AUCDL=0:0
SET AUCDAFLD=$ORDER(^DD("ACOMP",AUCDFILE,AUCDFLD,AUCDAFLE,AUCDAFLD))
IF AUCDAFLD=""
QUIT
DO ACOMP
+1 KILL AUCDAFLE,AUCDAFLD,AUCDX
+2 QUIT
ACOMP ;
+1 WRITE "."
+2 IF '$DATA(^DD(AUCDAFLE))
WRITE "|"
KILL ^DD("ACOMP",AUCDFILE,AUCDFLD,AUCDAFLE)
QUIT
+3 IF '$DATA(^DD(AUCDAFLE,AUCDAFLD))
WRITE "|"
KILL ^DD("ACOMP",AUCDFILE,AUCDFLD,AUCDAFLE,AUCDAFLD)
QUIT
+4 IF '($DATA(^DD(AUCDAFLE,AUCDAFLD,0))#2)
WRITE "|"
KILL ^DD("ACOMP",AUCDFILE,AUCDFLD,AUCDAFLE,AUCDAFLD)
QUIT
+5 SET AUCDX=$PIECE(^DD(AUCDAFLE,AUCDAFLD,0),U,2)
+6 IF AUCDX'["C"
WRITE "|"
KILL ^DD("ACOMP",AUCDFILE,AUCDFLD,AUCDAFLE,AUCDAFLD)
+7 QUIT
+8 ;
SBTRACE ; CHECK ALL SUB-FILES
+1 KILL AUCDSFL
SET AUCDC=1
SET AUCDSFL=""
SET AUCDSFL(AUCDC)=AUCDFILE
+2 FOR AUCDL=0:0
SET AUCDI=$ORDER(AUCDSFL(""))
IF AUCDI=""
QUIT
SET AUCDSF=AUCDSFL(AUCDI)
DO SBTRACE2
SET AUCDI=$ORDER(AUCDSFL(""))
WRITE "."
KILL AUCDSFL(AUCDI)
+3 KILL AUCDC,AUCDI,AUCDSF,AUCDSFL,AUCDY,AUCDZ
+4 QUIT
SBTRACE2 ;
+1 SET AUCDI=0
FOR AUCDL=0:0
SET AUCDI=$ORDER(^DD(AUCDSF,"SB",AUCDI))
IF AUCDI=""
QUIT
WRITE "."
SET AUCDC=AUCDC+1
SET AUCDSFL(AUCDC)=AUCDI
DO SBTRACE3
DO SBTRACE4
+2 QUIT
SBTRACE3 ;
+1 IF '$DATA(^DD(AUCDI,0,"UP"))
IF $DATA(^DIC(AUCDI))
WRITE !,?10,AUCDI," is a primary file. Deleting ^DD(",AUCDSF,",""SB"",",AUCDI,")"
KILL ^DD(AUCDSF,"SB",AUCDI)
QUIT
+2 IF $DATA(^DD(AUCDI,0,"PT"))
WRITE !,?10,AUCDI," sub-file has ""PT"" node. Deleting."
KILL ^DD(AUCDI,0,"PT")
+3 IF '$DATA(^DD(AUCDI,0,"UP"))
WRITE !,?10,AUCDI," has no ""UP"" node. Creating ^DD(",AUCDI,",0,""UP"")=",AUCDSF
SET ^DD(AUCDI,0,"UP")=AUCDSF
+4 IF ^DD(AUCDI,0,"UP")=AUCDSF
QUIT
+5 IF ^DD(AUCDI,0,"UP")=""
WRITE !,?10,AUCDI," ""UP"" node is NULL. Setting ^DD(",AUCDI,",0,""UP"")=",AUCDSF
SET ^DD(AUCDI,0,"UP")=AUCDSF
QUIT
+6 WRITE !,?10,AUCDSF," lists ",AUCDI," as a sub-file. The ""UP"" node in ",!,?10+$LENGTH(AUCDSF)+1,AUCDI," is ",^DD(AUCDI,0,"UP"),"."
+7 IF $DATA(^DD(^DD(AUCDI,0,"UP"),"SB",AUCDSF))
WRITE !,?12,"The ""SB"" in ",^DD(AUCDI,0,"UP")," agrees. Fixing."
KILL ^DD(AUCDSF,"SB",AUCDI)
QUIT
+8 IF '$TEST
WRITE !,?12,"The ""SB"" in ",^DD(AUCDI,0,"UP")," disagrees. Fixing."
SET ^DD(AUCDI,0,"UP")=AUCDSF
+9 QUIT
SBTRACE4 ;
+1 IF '$DATA(^DD(AUCDI,0,"NM"))
WRITE !,?10,"Sub-file "_AUCDI_" has no ^DD("_AUCDI_",0,""NM"") entry. Fixing."
DO SBTFIX
+2 IF '$TEST
SET AUCDX=$ORDER(^("NM",""))
SET AUCDX=$ORDER(^(AUCDX))
IF AUCDX'=""
WRITE !,?10,"Sub-file "_AUCDI_" has multiple names. Fixing."
DO SBTFIX
+3 QUIT
SBTFIX ; FIX "NM"
+1 KILL ^DD(AUCDI,0,"NM")
+2 IF '$DATA(^DD(AUCDI,0,"UP"))
WRITE !,?12,"Can't fix. No ""UP"" node."
QUIT
+3 SET AUCDX=^("UP")
+4 IF AUCDX=""
WRITE !,?12,"Can't fix. ""UP"" node is NULL."
QUIT
+5 IF '$DATA(^DD(AUCDX,"SB",AUCDI))
WRITE !,?12,"Can't fix because can't locate parent field."
QUIT
+6 SET AUCDY=$ORDER(^(AUCDI,""))
SET AUCDZ=$PIECE(^DD(AUCDX,AUCDY,0),U,1)
+7 SET ^DD(AUCDI,0,"NM",AUCDZ)=""
+8 QUIT
