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

DDFIX.m

Go to the documentation of this file. 
  1. DDFIX ;SFCIOFO/S0/MKO VARIOUS DD AND DIC FIXES ;9:17 AM  15 Mar 1999
  1.  ;;22.0;VA FileMan;;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. FIXPT ; ==> Fix Bad "PT" Nodes <==
  1.  ;
  1.  N EP,ESC
  1.  I '$D(XPDNM) S EP="PT" D DEVICE
  1.  I $D(ESC) G EXIT
  1. DEQPT N DICFILE,DDFILE,DDFIELD,PGLEN,PG,RPTDT,X
  1.  U IO
  1.  D RPTDT
  1.  S PGLEN=IOSL-5,PG=0
  1.  I '$D(XPDNM) D PTHDR
  1.  ; Loop thru DIC(<file #>,
  1.  S DICFILE=1.99999
  1.  F  S DICFILE=$O(^DIC(DICFILE)) Q:DICFILE'>1.99999!$D(ESC)  D
  1.  . ; Loop thru DD(DICFILE,0,"PT",<file #>
  1.  . S DDFILE=1.99999
  1.  . F  S DDFILE=$O(^DD(DICFILE,0,"PT",DDFILE)) Q:DDFILE'>1.99999!$D(ESC)  D
  1.  .. I $D(^DD(DDFILE,0))#2 D  Q  ; File Exists
  1.  ... ; Check Fields Exists
  1.  ... S DDFIELD=0
  1.  ... F  S DDFIELD=$O(^DD(DICFILE,0,"PT",DDFILE,DDFIELD)) Q:'DDFIELD!$D(ESC)  D
  1.  .... I $D(^DD(DDFILE,DDFIELD,0))#2 D  Q  ; Field is still in DD
  1.  ..... I ($P(^(0),U,2)'["P")&($P(^(0),U,2)'["V") D  Q  ; Field Still A Pointer?
  1.  ...... S X="*File: "_DDFILE_" Field: "_DDFIELD_" is Not a Pointer Type." D RPTOUT
  1.  ...... S X="   Deleting ""PT"" node: "_$NA(^DD(DICFILE,0,"PT",DDFILE,DDFIELD)) D RPTOUT,K1 Q
  1.  ..... I $P(^(0),U,2)["P",+$P($P(^(0),U,2),"P",2)'=DICFILE D  Q  ; Field Still Point To Same File?
  1.  ...... S X="*File: "_DDFILE_" Field: "_DDFIELD_" Does Not Point To File: "_DICFILE_"." D RPTOUT
  1.  ...... S X="  Deleting ""PT"" Node: "_$NA(^DD(DICFILE,0,"PT",DDFILE,DDFIELD)) D RPTOUT,K1 Q
  1.  .... ; **Field No Longer Exists
  1.  .... S X="*Field: "_DDFIELD_" in File: "_DDFILE_" does Not Exist." D RPTOUT
  1.  .... S X="  Deleting ""PT"" node: "_$NA(^DD(DICFILE,0,"PT",DDFILE,DDFIELD)) D RPTOUT,K1 Q
  1.  .. ; **File No Longer Exists
  1.  .. S X="*File: "_DDFILE_" Does Not Exist." D RPTOUT
  1.  .. S X="  Deleting ""PT"" node: "_$NA(^DD(DICFILE,0,"PT",DDFILE)) D RPTOUT
  1.  .. K ^DD(DICFILE,0,"PT",DDFILE)
  1.  G EXIT ; GoTo Common Exit
  1. K1 ; Kill at Field Level
  1.  K ^DD(DICFILE,0,"PT",DDFILE,DDFIELD)
  1.  Q
  1. PTHDR ; Fix "PT" nodes Report Header
  1.  I $E(IOST,1,2)="C-" D  Q:$D(ESC)
  1.  . I PG D PAUSE Q:$D(ESC)
  1.  . W @IOF
  1.  I PG W @IOF
  1.  S PG=PG+1
  1.  W "Fix ""PT"" Nodes Report     "_RPTDT,?(IOM-10),"Page: "_PG,!
  1.  N X
  1.  S X="",$P(X,"-",(IOM-1))="" W X,!
  1.  Q
  1.  ;
  1. FIXNM ; ==> Fix Duplicate 'NM' Nodes <==
  1.  ; From patch DI*21*50, routine DIPR50
  1.  ;
  1.  N EP,ESC
  1.  I '$D(XPDNM) S EP="NM" D DEVICE
  1.  I $D(ESC) G EXIT
  1. DEQNM N DDFILE,DDNAME,DDNEW,PGLEN,PG,RPTDT,X
  1.  U IO
  1.  D RPTDT
  1.  S PGLEN=IOSL-5,PG=0
  1.  I '$D(XPDNM) D NMHDR
  1.  S DDFILE=1.99999
  1.  F  S DDFILE=$O(^DD(DDFILE)) Q:'DDFILE!$D(ESC)  D
  1.  . ; Check and repair duplicate "NM" nodes
  1.  . S DDNAME=$O(^DD(DDFILE,0,"NM","")) Q:DDNAME=""
  1.  . I $O(^DD(DDFILE,0,"NM",DDNAME))="" Q
  1.  . S X="*File/Subfile: "_DDFILE_" has duplicate 'NM' nodes."
  1.  . D RPTOUT
  1.  . S DDNEW=$S($D(^DIC(DDFILE,0))#2:$P(^(0),U),1:$P(^DD(DDFILE,0)," SUB-FIELD"))
  1.  . Q:DDNEW=""
  1.  . K ^DD(DDFILE,0,"NM")
  1.  . S ^DD(DDFILE,0,"NM",DDNEW)=""
  1.  . S X="  ""NM"" node will be set to: "_DDNEW
  1.  . D RPTOUT
  1.  G EXIT ; GoTo Common Exit Point
  1. NMHDR ; Fix "NM" nodes Report Header
  1.  I $E(IOST,1,2)="C-" D  Q:$D(ESC)
  1.  . I PG D PAUSE Q:$D(ESC)
  1.  . W @IOF
  1.  I PG W @IOF
  1.  S PG=PG+1
  1.  W "Fix Duplicate ""NM"" Nodes Report     "_RPTDT,?(IOM-10),"Page: "_PG,!
  1.  N X
  1.  S X="",$P(X,"-",(IOM-1))="" W X,!
  1.  Q
  1.  ;
  1. FIXAG ; ==> Application Group Multiple Bad Xrefs <==
  1.  ; From patch DI*21*58, routine DIPR58
  1.  ;
  1.  N EP,ESC
  1.  I '$D(XPDNM) S EP="AG" D DEVICE
  1.  I $D(ESC) G EXIT
  1. DEQAG N DDAGPKG,DDFILE,IEN,PGLEN,PG,RPTDT,X
  1.  U IO
  1.  D RPTDT
  1.  S PGLEN=IOSL-5,PG=0
  1.  I '$D(XPDNM) D AGHDR
  1.  S DDFILE=1.99999
  1.  F  S DDFILE=$O(^DIC(DDFILE)) Q:DDFILE<1.99999  D
  1.  . I '$D(^DIC(DDFILE,"%")) Q  ; No App. Group Multiple
  1.  . S DDAGPKG=""
  1.  . F  S DDAGPKG=$O(^DIC(DDFILE,"%","B",DDAGPKG)) Q:DDAGPKG=""  D
  1.  .. S IEN=0
  1.  .. F  S IEN=$O(^DIC(DDFILE,"%","B",DDAGPKG,IEN)) Q:'IEN  D
  1.  ... I $P($G(^DIC(DDFILE,"%",IEN,0)),U)=DDAGPKG Q
  1.  ... S X="Deleting App. Group "_DDAGPKG_" ""B"" xref: "_$NA(^DIC(DDFILE,"%","B",DDAGPKG,IEN))
  1.  ... D RPTOUT
  1.  ... K ^DIC(DDFILE,"%","B",DDAGPKG,IEN)
  1. AC ; Loop Thru "AC" xref and Remove Any Entries That Point to
  1.  ; Files That Do Not Exist
  1.  S DDAGPKG=""
  1.  F  S DDAGPKG=$O(^DIC("AC",DDAGPKG)) Q:DDAGPKG=""  D
  1.  . S DDFILE=1.99999
  1.  . F  S DDFILE=$O(^DIC("AC",DDAGPKG,DDFILE)) Q:DDFILE<1.99999  D
  1.  .. I $D(^DIC(DDFILE,0))[0 D  Q
  1.  ... S X="Deleting ""AC"" xref: "_$NA(^DIC("AC",DDAGPKG,DDFILE))
  1.  ... D RPTOUT
  1.  ... K ^DIC("AC",DDAGPKG,DDFILE)
  1.  .. S IEN=0
  1.  .. F  S IEN=$O(^DIC("AC",DDAGPKG,DDFILE,IEN)) Q:'IEN  D
  1.  ... I $P($G(^DIC(DDFILE,"%",IEN,0)),U)'=DDAGPKG D
  1.  .... S X="Deleting ""AC"" xref: "_$NA(^DIC("AC",DDAGPKG,DDFILE,IEN))
  1.  .... D RPTOUT
  1.  .... K ^DIC("AC",DDAGPKG,DDFILE,IEN)
  1.  G EXIT ; GoTo Common Exit Point
  1. AGHDR ; Fix Application Group Xrefs Report Header
  1.  I $E(IOST,1,2)="C-" D  Q:$D(ESC)
  1.  . I PG D PAUSE Q:$D(ESC)
  1.  . W @IOF
  1.  I PG W @IOF
  1.  S PG=PG+1
  1.  W "Fix Application Group Xrefs Report     "_RPTDT,?(IOM-10),"Page: "_PG,!
  1.  N X
  1.  S X="",$P(X,"-",(IOM-1))="" W X,!
  1.  Q
  1.  ;
  1.  ; Common For All Entry Points
  1.  ;
  1. DEVICE ; Output Device Selection
  1.  S %ZIS="MQ"
  1.  D ^%ZIS
  1.  I POP S ESC=1 Q  ;User Escaped Device Selection
  1.  I $D(IO("Q")) D
  1.  . S ZTDESC=$S(EP="PT":"FIX PT NODES",EP="NM":"FIX DUPLICATE 'NM' NODES",EP="AG":"FIX APPLICATION GROUP XREFS",1:"")
  1.  . S ZTRTN=$S(EP="PT":"DEQPT",EP="NM":"DEQNM",EP="AG":"DEQAG",1:"")_"^DDFIX"
  1.  . S ZTSAVE("EP")=""
  1.  . D ^%ZTLOAD
  1.  . I $D(ZTSK)#2 W !,"Report queued!",!,"Task number: "_$G(ZTSK),!
  1.  . S ESC=1
  1.  . K ZTSK,ZTDESC,ZTRTN,ZTSAVE
  1.  . D HOME^%ZIS
  1.  Q
  1. RPTDT ; Get Report Date/Time
  1.  N %,%H,X,Y
  1.  S %H=$H
  1.  D YX^%DTC
  1.  S RPTDT=$P(Y,"@")_"@"_$E($P(Y,"@",2),1,5)
  1.  Q
  1. RPTOUT ; Print Messages
  1.  I $D(XPDNM) D MES^XPDUTL(X) Q  ;  KIDS install being used
  1.  W X,! ; KIDS install not being used
  1.  I $Y'>PGLEN Q
  1.  I EP="PT" D PTHDR Q
  1.  I EP="NM" D NMHDR Q
  1.  I EP="AG" D AGHDR Q
  1.  Q
  1. PAUSE ; End of Page Pause
  1.  N DIR,Y
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) K DTOUT,DUOUT,DIRUT,DIROUT S ESC=1 Q
  1.  Q
  1. EXIT ; Common Exit Point
  1.  I $E(IOST,1,2)="P-" D ^%ZISC
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  K EP
  1.  Q