Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XBCDIC3

XBCDIC3.m

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