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

XBCSPC.m

Go to the documentation of this file. 
  1. XBCSPC ; IHS/ADC/GTH - CHECK POTENTIAL SPECIFIER FIELDS ; [ 11/04/97  10:26 AM ]
  1.  ;;3.0;IHS/VA UTILITIES;**5**;FEB 07, 1997
  1.  ; XB*3*5 IHS/ADC/GTH 10-30-97 Fix bug in count of duplicate values.
  1.  ;
  1.  ; This routine checks selected field to see what percent of
  1.  ; the time it exists in the entries in a file, and if it
  1.  ; should be unique, it makes sure it is unique.
  1.  ;
  1. START ;
  1.  NEW CTRD,CTRT,CTRU,CTRX,ENTRY,FGBL,FIELD,FILE,NODE,PIECE,UNIQUE,XREF
  1.  D ^XBKVAR
  1.  F  D FILE Q:Y<1
  1.  D EOJ
  1.  Q
  1.  ;
  1. FILE ;
  1.  W !
  1.  I '$G(EXTERNAL) D  Q:Y<1
  1.  . S DIC=1,DIC(0)="AEMQ"
  1.  . D ^DIC
  1.  . KILL DIC
  1.  . Q:Y<1
  1.  . S FILE=+Y
  1.  .Q
  1.  S FGBL=^DIC(FILE,0,"GL"),X=$O(@(FGBL_"0)"))
  1.  I X'=+X W "  No data in file",*7 Q
  1.  F  D FIELD Q:Y<0
  1.  S Y=1
  1.  Q
  1.  ;
  1. FIELD ;
  1.  I '$G(EXTERNAL) D  Q:Y<0
  1.  . S DIC="^DD("_FILE_",",DIC(0)="AEMQ"
  1.  . D ^DIC
  1.  . KILL DIC
  1.  . Q:Y<0
  1.  . S FIELD=+Y
  1.  .Q
  1.  D FLD^XBFDINFO(FILE,FIELD,.X)
  1.  I '$D(X("NODE")) W *7 Q
  1.  I X("NODE")="" W *7 Q
  1.  S NODE=X("NODE"),PIECE=X("PIECE")
  1.  KILL DIRUT,X
  1.  I '$G(EXTERNAL) S UNIQUE=$$DIR^XBDIR("YO","Should field be unique","NO")
  1.  Q:$D(DIRUT)
  1.  D:UNIQUE CHKXREF
  1.  D CHKDATA
  1.  D LIST
  1.  S:$G(EXTERNAL) Y=-1
  1.  Q
  1.  ;
  1. LIST ;
  1.  W !!,CTRT," entries in file.",!,$FN(CTRD/CTRT*100,"T",2)," percent of entries have data.  ",$S(CTRT'=CTRD:CTRT-CTRD_" without data.",1:"")
  1.  I UNIQUE,XREF'="" D
  1.  . I CTRX=0 W !,"All entries with data have xref."
  1.  . E  W !,CTRD-CTRX," entr",$S(CTRD-CTRX=1:"y",1:"ies"),", ",$FN(CTRX/CTRD*100,"T",2)," percent of entries with data have no xref."
  1.  . Q
  1.  I UNIQUE D
  1.  . I CTRU=0 W !,"All ",$P(^DD(FILE,FIELD,0),U,1)," field values are unique."
  1.  . E  W !,CTRU,$S(CTRU=1:" entry has a value that is ",1:" entries have values that are "),"not unique."
  1.  . I '$G(EXTERNAL),CTRU W !,"If you want to see duplicate values select global ^TMP(""XBCSPC"",",$J,"," KILL ^TMP("XBCSPC",$J,1) D ^%G
  1.  . Q
  1.  W !
  1.  Q
  1.  ;
  1. CHKXREF ; SEE IF UNIQUE SPECIFIER HAS REGULAR XREF
  1.  Q:$G(XREF)'=""
  1.  S XREF=""
  1.  D XREF^XBGXREFS(FILE,FIELD,.X)
  1.  F I=0:0 S I=$O(X(FIELD,I)) Q:I'=+I  I $P(X(FIELD,I),"^",3)="" S XREF=$P(X(FIELD,I),"^",2),XREF=""""_XREF_"""" Q
  1.  KILL X
  1.  I 'I W !,"The ",FIELD," field does not have a REGULAR xref."
  1.  E  W !,"Using the ",XREF," xref on the ",FIELD," field."
  1.  Q
  1.  ;
  1. CHKDATA ; CHECK DATA IN SELECTED FIELD
  1.  W !,"Checking data.  Please wait. "
  1.  KILL ^TMP("XBCSPC",$J)
  1.  S (CTRT,CTRD,CTRU,CTRX)=0
  1.  F ENTRY=0:0 S ENTRY=$O(@(FGBL_ENTRY_")")) Q:ENTRY'=+ENTRY  D
  1.  . S CTRT=CTRT+1
  1.  . Q:'$D(@(FGBL_ENTRY_","_NODE_")"))
  1.  . S X=$P(@(FGBL_ENTRY_","_NODE_")"),"^",PIECE)
  1.  . Q:X=""
  1.  . S CTRD=CTRD+1
  1.  . I UNIQUE,XREF'="",'$D(@(FGBL_XREF_","""_X_""","_ENTRY_")")) S CTRX=CTRX+1
  1.  . I UNIQUE D
  1.  .. ; I $D(^TMP("XBCSPC",$J,1,X)) S CTRU=CTRU+1,^TMP("XBCSPC",$J,2,X)=cCTRX ; XB*3*5 IHS/ADC/GTH 10-30-97 Fix bug in count of duplicate values.
  1.  .. I $D(^TMP("XBCSPC",$J,1,X)) S CTRU=CTRU+1,^(X)=$S($G(^TMP("XBCSPC",$J,2,X)):^(X)+1,1:2) ; XB*3*5 IHS/ADC/GTH 10-30-97 Fix bug in count of duplicate values.
  1.  .. E  S ^TMP("XBCSPC",$J,1,X)=0
  1.  .. Q
  1.  . Q
  1.  Q
  1.  ;
  1. EN(FILE,FIELD,XREF,UNIQUE) ; EXTERNAL ENTRY POINT TO ALLOW SPECIFID FILE/FIELD
  1.  ; pass by value  *** will abort if values not passed ***
  1.  NEW CTRD,CTRT,CTRU,CTRX,ENTRY,EXTERNAL,FGBL,NODE,PIECE
  1.  S EXTERNAL=1
  1.  I FILE,FIELD,XREF'="",UNIQUE'=""
  1.  E  Q
  1.  S XREF=""""_XREF_""""
  1.  D FILE
  1.  KILL DIRUT,I,X,Y
  1.  Q
  1.  ;
  1. EOJ ;
  1.  KILL DIRUT,I,X,Y
  1.  KILL ^TMP("XBCSPC",$J)
  1.  Q
  1.  ;