close Warning: Can't use blame annotator: 
svn blame failed on IHS-VA_UTILITIES-XB/trunk/XBCSPC.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: IHS-VA_UTILITIES-XB/trunk/XBCSPC.m@ 789

Last change on this file since 789 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.
File size: 3.2 KB
RevLine 
1XBCSPC ; IHS/ADC/GTH - CHECK POTENTIAL SPECIFIER FIELDS ; [ 11/04/97 10:26 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ; XB*3*5 IHS/ADC/GTH 10-30-97 Fix bug in count of duplicate values.
4 ;
5 ; This routine checks selected field to see what percent of
6 ; the time it exists in the entries in a file, and if it
7 ; should be unique, it makes sure it is unique.
8 ;
9START ;
10 NEW CTRD,CTRT,CTRU,CTRX,ENTRY,FGBL,FIELD,FILE,NODE,PIECE,UNIQUE,XREF
11 D ^XBKVAR
12 F D FILE Q:Y<1
13 D EOJ
14 Q
15 ;
16FILE ;
17 W !
18 I '$G(EXTERNAL) D Q:Y<1
19 . S DIC=1,DIC(0)="AEMQ"
20 . D ^DIC
21 . KILL DIC
22 . Q:Y<1
23 . S FILE=+Y
24 .Q
25 S FGBL=^DIC(FILE,0,"GL"),X=$O(@(FGBL_"0)"))
26 I X'=+X W " No data in file",*7 Q
27 F D FIELD Q:Y<0
28 S Y=1
29 Q
30 ;
31FIELD ;
32 I '$G(EXTERNAL) D Q:Y<0
33 . S DIC="^DD("_FILE_",",DIC(0)="AEMQ"
34 . D ^DIC
35 . KILL DIC
36 . Q:Y<0
37 . S FIELD=+Y
38 .Q
39 D FLD^XBFDINFO(FILE,FIELD,.X)
40 I '$D(X("NODE")) W *7 Q
41 I X("NODE")="" W *7 Q
42 S NODE=X("NODE"),PIECE=X("PIECE")
43 KILL DIRUT,X
44 I '$G(EXTERNAL) S UNIQUE=$$DIR^XBDIR("YO","Should field be unique","NO")
45 Q:$D(DIRUT)
46 D:UNIQUE CHKXREF
47 D CHKDATA
48 D LIST
49 S:$G(EXTERNAL) Y=-1
50 Q
51 ;
52LIST ;
53 W !!,CTRT," entries in file.",!,$FN(CTRD/CTRT*100,"T",2)," percent of entries have data. ",$S(CTRT'=CTRD:CTRT-CTRD_" without data.",1:"")
54 I UNIQUE,XREF'="" D
55 . I CTRX=0 W !,"All entries with data have xref."
56 . 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."
57 . Q
58 I UNIQUE D
59 . I CTRU=0 W !,"All ",$P(^DD(FILE,FIELD,0),U,1)," field values are unique."
60 . E W !,CTRU,$S(CTRU=1:" entry has a value that is ",1:" entries have values that are "),"not unique."
61 . I '$G(EXTERNAL),CTRU W !,"If you want to see duplicate values select global ^TMP(""XBCSPC"",",$J,"," KILL ^TMP("XBCSPC",$J,1) D ^%G
62 . Q
63 W !
64 Q
65 ;
66CHKXREF ; SEE IF UNIQUE SPECIFIER HAS REGULAR XREF
67 Q:$G(XREF)'=""
68 S XREF=""
69 D XREF^XBGXREFS(FILE,FIELD,.X)
70 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
71 KILL X
72 I 'I W !,"The ",FIELD," field does not have a REGULAR xref."
73 E W !,"Using the ",XREF," xref on the ",FIELD," field."
74 Q
75 ;
76CHKDATA ; CHECK DATA IN SELECTED FIELD
77 W !,"Checking data. Please wait. "
78 KILL ^TMP("XBCSPC",$J)
79 S (CTRT,CTRD,CTRU,CTRX)=0
80 F ENTRY=0:0 S ENTRY=$O(@(FGBL_ENTRY_")")) Q:ENTRY'=+ENTRY D
81 . S CTRT=CTRT+1
82 . Q:'$D(@(FGBL_ENTRY_","_NODE_")"))
83 . S X=$P(@(FGBL_ENTRY_","_NODE_")"),"^",PIECE)
84 . Q:X=""
85 . S CTRD=CTRD+1
86 . I UNIQUE,XREF'="",'$D(@(FGBL_XREF_","""_X_""","_ENTRY_")")) S CTRX=CTRX+1
87 . I UNIQUE D
88 .. ; 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.
89 .. 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.
90 .. E S ^TMP("XBCSPC",$J,1,X)=0
91 .. Q
92 . Q
93 Q
94 ;
95EN(FILE,FIELD,XREF,UNIQUE) ; EXTERNAL ENTRY POINT TO ALLOW SPECIFID FILE/FIELD
96 ; pass by value *** will abort if values not passed ***
97 NEW CTRD,CTRT,CTRU,CTRX,ENTRY,EXTERNAL,FGBL,NODE,PIECE
98 S EXTERNAL=1
99 I FILE,FIELD,XREF'="",UNIQUE'=""
100 E Q
101 S XREF=""""_XREF_""""
102 D FILE
103 KILL DIRUT,I,X,Y
104 Q
105 ;
106EOJ ;
107 KILL DIRUT,I,X,Y
108 KILL ^TMP("XBCSPC",$J)
109 Q
110 ;
Note: See TracBrowser for help on using the repository browser.