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