BSTSSRCH ;GDIT/HS/ALA-Search terms ; 15 Nov 2012 4:26 PM
;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62
Q
;
SRC(OUT,IN) ;Input
; OUT - Output variable/global to return information in (VAR)
; IN - BSTSWS Array
;
;Output
; @VAR@(#) - [1]^[2]^[3]
; [1] - Concept ID
; [2] - DTS ID
; [3] - Descriptor ID
;
;Make call to new search logic
Q $$SRC^BSTSLSRC(.OUT,.IN)
;
N II,TEXT,ARRAY,NM,TMP,SEARCH,STYPE,NMID,SUB,SNAPDT,MAX,BCTCHRC,BCTCHCT,DEBUG,CHKDT
N SCREEN,FILE,FIELD,FLAGS,INDEX,VAL,ERROR,TMP2,RES,RCNT,OCNT,CNT,%,%1,I,X,INMID
;
;Define input variables
F II=1:1 S TEXT=$P($T(FLD+II),";;",2) Q:TEXT="" S ARRAY($P(TEXT,"^",1))=$P(TEXT,"^",2)
S NM="" F S NM=$O(IN(NM)) Q:NM="" I $G(ARRAY(NM))'="" S @ARRAY(NM)=IN(NM)
S:$G(NMID)="" NMID=36
;
S INMID=$O(^BSTS(9002318.1,"B",NMID,"")) I INMID="" Q "0^Invalid Codeset"
;
S CHKDT=$P($$DATE^BSTSUTIL(IN("SNAPDT")),".") I CHKDT="" Q "0^Invalid Check Date"
;
;Define scratch global
S TMP=$NA(^TMP("BSTSSRCH",$J))
K @TMP
;
;Define FileMan scratch global
K ^TMP("DILIST",$J)
;
;Loop through each search term and perform look up
S SCREEN="I $P(^(0),U,8)="_INMID
S FILE=9002318.3,FIELD=".02;.03;.09;1",FLAGS="PCM",INDEX="E"
F II=1:1:$L(SEARCH," ") S VAL=$P(SEARCH," ",II) D
. N N,TOT,VALUE
. S VALUE=$$UP^XLFSTR(VAL)
. D FIND^DIC(FILE,"",FIELD,FLAGS,VALUE,"",INDEX,SCREEN,"","","ERROR")
. S TOT=$P($G(^TMP("DILIST",$J,0)),"^",1)
. I TOT=0 Q
. F N=1:1:TOT D FND(N,SEARCH,NMID)
. Q
;
;Now Filter and Sort by finding count
S TMP2=$NA(^TMP("BSTSSRCH2",$J)) K @TMP2
S RES="" F S RES=$O(@TMP@(RES)) Q:RES="" D
. N FILTER,CNT,CONC,CIEN,RIN,ROUT
. S FILTER=0
. ;
. ;GET THE CONC and CIEN
. S CONC=$P(RES,U) Q:CONC=""
. S CIEN=$$CIEN^BSTSLKP(CONC,NMID) Q:CIEN=""
. ;
. ;Quit if out of date
. I $$GET1^DIQ(9002318.4,CIEN_",",".11","I")="Y" Q
. ;
. ;Check revision dates
. S RIN=$$GET1^DIQ(9002318.4,CIEN_",",".05","I")
. S ROUT=$$GET1^DIQ(9002318.4,CIEN_",",".06","I")
. I CHKDT]"",RIN]"",CHKDT<RIN Q ;Check date is before revision in
. I CHKDT]"",ROUT]"",CHKDT>ROUT Q ;Check date is after revision out
. ;
. ;Subset filter
. I SUB]"" D Q:FILTER
.. N SB,ISB
.. S FILTER=1
.. F ISB=1:1:$L(SUB,"~") S SB=$P(SUB,"~",ISB) I SB]"",$D(^BSTS(9002318.4,CIEN,4,"B",SB)) S FILTER=0
. ;
. S CNT=@TMP@(RES),@TMP2@(CNT,RES)=""
;
;Set up output
S (RCNT,OCNT)=0,CNT="" F S CNT=$O(@TMP2@(CNT),-1) Q:CNT="" D
. N RES
. S RES="" F S RES=$O(@TMP2@(CNT,RES),-1) Q:RES="" D
.. N D,DI
.. S RCNT=RCNT+1 Q:RCNT>MAX
.. ;
.. ;Start at record
.. I +BCTCHRC>0,RCNT<(+BCTCHRC) Q
.. S OCNT=OCNT+1
.. ;
.. ;Grab BCTCHCT records
.. I +BCTCHCT>0,OCNT>(+BCTCHCT) Q
.. ;
.. ;Set up output
.. S @OUT@(OCNT)=RES
;
K @TMP,@TMP2,^TMP("DILIST",$J,0)
;
;Return 1 on successful search
Q $S(OCNT>0:1,1:0)
;
FDESC(CIEN) ;EP - Retrieve Description Id of FSN
;
N TIEN,NMID,DESC
;
S NMID=$$GET1^DIQ(9002318.4,CIEN_",",.07,"E") Q:NMID="" ""
S (DESC,TIEN)="" F S TIEN=$O(^BSTS(9002318.3,"C",NMID,CIEN,TIEN)) Q:TIEN="" D Q:DESC
. N TYPE
. S TYPE=$$GET1^DIQ(9002318.3,TIEN_",",.09,"I") I TYPE'="F" Q
. S DESC=$$GET1^DIQ(9002318.3,TIEN_",",.02,"E")
;
Q DESC
;
PDESC(CIEN) ;EP - Retrieve Description Id of Preferred Term
;
N TIEN,NMID,DESC
;
S NMID=$$GET1^DIQ(9002318.4,CIEN_",",.07,"E") Q:NMID="" ""
S (DESC,TIEN)="" F S TIEN=$O(^BSTS(9002318.3,"C",NMID,CIEN,TIEN)) Q:TIEN="" D Q:DESC
. N TYPE,TERM
. S TYPE=$$GET1^DIQ(9002318.3,TIEN_",",.09,"I")
. ;
. ;For SNOMED look for preferred
. ;For UNII look for FSN
. ;For RXNORM look for preferred
. I NMID=36,TYPE'="P" Q
. I NMID=5180,TYPE'="F" Q
. I NMID=1552,TYPE'="P" Q
. I NMID>32770,NMID<32780,TYPE'="F" Q
. ;
. S DESC=$$GET1^DIQ(9002318.3,TIEN_",",.02,"E")
. S TERM=$$GET1^DIQ(9002318.3,TIEN_",",1,"E")
. S DESC=DESC_U_TERM
;
Q DESC
;
FND(N,SEARCH,NMID) ;Set up return entry
N ENT,CPT,FILTER,DESC,TERM,WGT,USEARCH,PC,UTERM
S CPT=$P(^TMP("DILIST",$J,N,0),U,4) Q:CPT=""
S ENT=$P(^BSTS(9002318.4,CPT,0),"^",2)_"^"_$P(^(0),"^",8)_"^"
S DESC=$P(^TMP("DILIST",$J,N,0),U,3) Q:DESC=""
S TERM=$P(^TMP("DILIST",$J,N,0),U,6)
;
S FILTER=0
;
;Skip FSN terms and out of date entries
D Q:FILTER
. N TIEN,TTYP
. S TIEN=$O(^BSTS(9002318.3,"D",INMID,DESC,"")) Q:TIEN=""
. S TTYP=$$GET1^DIQ(9002318.3,TIEN_",",.09,"I")
. ;I TTYP="F" S FILTER=1
. I ((NMID<32771)!(NMID>32780)),TTYP="F" S FILTER=1 Q
. I $$GET1^DIQ(9002318.3,TIEN_",",.11,"I")="Y" S FILTER=1
;
;Implement AND logic - must have all terms
D Q:FILTER
. NEW PC
. FOR PC=1:1:$L(SEARCH," ") D Q:FILTER
.. NEW WD
.. S WD=$P(SEARCH," ",PC)
.. ;
.. ;Strip out comparison words
.. I (WD="")!(WD="OR")!(WD="AND")!(WD="NOT") Q
.. I ($$UP^XLFSTR(TERM))'[($$UP^XLFSTR(WD)) S FILTER=1
;
;Determine weight value (look for exact match)
S USEARCH=$$UP^XLFSTR(SEARCH)
S UTERM=$$UP^XLFSTR(TERM)
S WGT=1 F PC=1:1:$L(USEARCH," ") I $P(USEARCH," ",PC)=$P(UTERM," ",PC) S WGT=WGT+1
I UTERM=USEARCH S WGT=WGT+5
;
;Log entry
I STYPE="F" S DESC=$P($$PDESC^BSTSSRCH(CPT),U) Q:DESC=""
S ENT=ENT_DESC
S @TMP@(ENT)=$G(@TMP@(ENT))+WGT
;
Q
;
FLD ;;
;;SEARCH^SEARCH
;;STYPE^STYPE
;;NAMESPACEID^NMID
;;SUBSET^SUB
;;SNAPDT^SNAPDT
;;MAXRECS^MAX
;;BCTCHRC^BCTCHRC
;;BCTCHCT^BCTCHCT
;;DEBUG^DEBUG
Q
;
SXF ;EP - Set cross-reference
S %1=1 F %=1:1:$L(X)+1 D
. S I=$E(X,%)
. I "(,.?! '/&:;)"[I S I=$E($E(X,%1,%-1),1,30),%1=%+1
. S I=$$UP^XLFSTR(I)
. I $L(I)>2,^DD("KWIC")'[I D
.. NEW CDSET
.. S CDSET=$$GET1^DIQ(9002318.3,DA_",",.08,"E") Q:CDSET=""
.. ;
.. ;Strip leading '-'/'+'
.. I "-+"[$E(I,1) S I=$E(I,2,9999)
.. ;
.. ;Strip quotes
.. S I=$TR(I,"""","")
.. ;
.. ;Save entry
.. S ^BSTS(9002318.3,"E",CDSET,I,DA)=""
Q
;
KXF ;EP - Kill cross-reference
S %1=1 F %=1:1:$L(X)+1 D
. S I=$E(X,%)
. I "(,.?! '/&:;)"[I S I=$E($E(X,%1,%-1),1,30),%1=%+1
. S I=$$UP^XLFSTR(I)
. I $L(I)>2 D
.. NEW CDSET
.. S CDSET=$$GET1^DIQ(9002318.3,DA_",",.08,"E") Q:CDSET=""
.. ;
.. ;Strip leading '-'/'+'
.. I "-+"[$E(I,1) S I=$E(I,2,9999)
.. ;
.. ;Strip quotes
.. S I=$TR(I,"""","")
.. ;
.. ;Kill entry
.. K ^BSTS(9002318.3,"E",CDSET,I,DA)
Q
;
DETAIL(OUT,BSTSWS,RESULT) ;EP - Return Details for each Concept/Term
;
;Return the concept detail
;
;Call moved to new routine because of space issues
Q $$DETAIL^BSTSCDET(OUT,.BSTSWS,.RESULT)
BSTSSRCH ;GDIT/HS/ALA-Search terms ; 15 Nov 2012 4:26 PM
+1 ;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62
+2 QUIT
+3 ;
SRC(OUT,IN) ;Input
+1 ; OUT - Output variable/global to return information in (VAR)
+2 ; IN - BSTSWS Array
+3 ;
+4 ;Output
+5 ; @VAR@(#) - [1]^[2]^[3]
+6 ; [1] - Concept ID
+7 ; [2] - DTS ID
+8 ; [3] - Descriptor ID
+9 ;
+10 ;Make call to new search logic
+11 QUIT $$SRC^BSTSLSRC(.OUT,.IN)
+12 ;
+13 NEW II,TEXT,ARRAY,NM,TMP,SEARCH,STYPE,NMID,SUB,SNAPDT,MAX,BCTCHRC,BCTCHCT,DEBUG,CHKDT
+14 NEW SCREEN,FILE,FIELD,FLAGS,INDEX,VAL,ERROR,TMP2,RES,RCNT,OCNT,CNT,%,%1,I,X,INMID
+15 ;
+16 ;Define input variables
+17 FOR II=1:1
SET TEXT=$PIECE($TEXT(FLD+II),";;",2)
IF TEXT=""
QUIT
SET ARRAY($PIECE(TEXT,"^",1))=$PIECE(TEXT,"^",2)
+18 SET NM=""
FOR
SET NM=$ORDER(IN(NM))
IF NM=""
QUIT
IF $GET(ARRAY(NM))'=""
SET @ARRAY(NM)=IN(NM)
+19 IF $GET(NMID)=""
SET NMID=36
+20 ;
+21 SET INMID=$ORDER(^BSTS(9002318.1,"B",NMID,""))
IF INMID=""
QUIT "0^Invalid Codeset"
+22 ;
+23 SET CHKDT=$PIECE($$DATE^BSTSUTIL(IN("SNAPDT")),".")
IF CHKDT=""
QUIT "0^Invalid Check Date"
+24 ;
+25 ;Define scratch global
+26 SET TMP=$NAME(^TMP("BSTSSRCH",$JOB))
+27 KILL @TMP
+28 ;
+29 ;Define FileMan scratch global
+30 KILL ^TMP("DILIST",$JOB)
+31 ;
+32 ;Loop through each search term and perform look up
+33 SET SCREEN="I $P(^(0),U,8)="_INMID
+34 SET FILE=9002318.3
SET FIELD=".02;.03;.09;1"
SET FLAGS="PCM"
SET INDEX="E"
+35 FOR II=1:1:$LENGTH(SEARCH," ")
SET VAL=$PIECE(SEARCH," ",II)
Begin DoDot:1
+36 NEW N,TOT,VALUE
+37 SET VALUE=$$UP^XLFSTR(VAL)
+38 DO FIND^DIC(FILE,"",FIELD,FLAGS,VALUE,"",INDEX,SCREEN,"","","ERROR")
+39 SET TOT=$PIECE($GET(^TMP("DILIST",$JOB,0)),"^",1)
+40 IF TOT=0
QUIT
+41 FOR N=1:1:TOT
DO FND(N,SEARCH,NMID)
+42 QUIT
End DoDot:1
+43 ;
+44 ;Now Filter and Sort by finding count
+45 SET TMP2=$NAME(^TMP("BSTSSRCH2",$JOB))
KILL @TMP2
+46 SET RES=""
FOR
SET RES=$ORDER(@TMP@(RES))
IF RES=""
QUIT
Begin DoDot:1
+47 NEW FILTER,CNT,CONC,CIEN,RIN,ROUT
+48 SET FILTER=0
+49 ;
+50 ;GET THE CONC and CIEN
+51 SET CONC=$PIECE(RES,U)
IF CONC=""
QUIT
+52 SET CIEN=$$CIEN^BSTSLKP(CONC,NMID)
IF CIEN=""
QUIT
+53 ;
+54 ;Quit if out of date
+55 IF $$GET1^DIQ(9002318.4,CIEN_",",".11","I")="Y"
QUIT
+56 ;
+57 ;Check revision dates
+58 SET RIN=$$GET1^DIQ(9002318.4,CIEN_",",".05","I")
+59 SET ROUT=$$GET1^DIQ(9002318.4,CIEN_",",".06","I")
+60 ;Check date is before revision in
IF CHKDT]""
IF RIN]""
IF CHKDT<RIN
QUIT
+61 ;Check date is after revision out
IF CHKDT]""
IF ROUT]""
IF CHKDT>ROUT
QUIT
+62 ;
+63 ;Subset filter
+64 IF SUB]""
Begin DoDot:2
+65 NEW SB,ISB
+66 SET FILTER=1
+67 FOR ISB=1:1:$LENGTH(SUB,"~")
SET SB=$PIECE(SUB,"~",ISB)
IF SB]""
IF $DATA(^BSTS(9002318.4,CIEN,4,"B",SB))
SET FILTER=0
End DoDot:2
IF FILTER
QUIT
+68 ;
+69 SET CNT=@TMP@(RES)
SET @TMP2@(CNT,RES)=""
End DoDot:1
+70 ;
+71 ;Set up output
+72 SET (RCNT,OCNT)=0
SET CNT=""
FOR
SET CNT=$ORDER(@TMP2@(CNT),-1)
IF CNT=""
QUIT
Begin DoDot:1
+73 NEW RES
+74 SET RES=""
FOR
SET RES=$ORDER(@TMP2@(CNT,RES),-1)
IF RES=""
QUIT
Begin DoDot:2
+75 NEW D,DI
+76 SET RCNT=RCNT+1
IF RCNT>MAX
QUIT
+77 ;
+78 ;Start at record
+79 IF +BCTCHRC>0
IF RCNT<(+BCTCHRC)
QUIT
+80 SET OCNT=OCNT+1
+81 ;
+82 ;Grab BCTCHCT records
+83 IF +BCTCHCT>0
IF OCNT>(+BCTCHCT)
QUIT
+84 ;
+85 ;Set up output
+86 SET @OUT@(OCNT)=RES
End DoDot:2
End DoDot:1
+87 ;
+88 KILL @TMP,@TMP2,^TMP("DILIST",$JOB,0)
+89 ;
+90 ;Return 1 on successful search
+91 QUIT $SELECT(OCNT>0:1,1:0)
+92 ;
FDESC(CIEN) ;EP - Retrieve Description Id of FSN
+1 ;
+2 NEW TIEN,NMID,DESC
+3 ;
+4 SET NMID=$$GET1^DIQ(9002318.4,CIEN_",",.07,"E")
IF NMID=""
QUIT ""
+5 SET (DESC,TIEN)=""
FOR
SET TIEN=$ORDER(^BSTS(9002318.3,"C",NMID,CIEN,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+6 NEW TYPE
+7 SET TYPE=$$GET1^DIQ(9002318.3,TIEN_",",.09,"I")
IF TYPE'="F"
QUIT
+8 SET DESC=$$GET1^DIQ(9002318.3,TIEN_",",.02,"E")
End DoDot:1
IF DESC
QUIT
+9 ;
+10 QUIT DESC
+11 ;
PDESC(CIEN) ;EP - Retrieve Description Id of Preferred Term
+1 ;
+2 NEW TIEN,NMID,DESC
+3 ;
+4 SET NMID=$$GET1^DIQ(9002318.4,CIEN_",",.07,"E")
IF NMID=""
QUIT ""
+5 SET (DESC,TIEN)=""
FOR
SET TIEN=$ORDER(^BSTS(9002318.3,"C",NMID,CIEN,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+6 NEW TYPE,TERM
+7 SET TYPE=$$GET1^DIQ(9002318.3,TIEN_",",.09,"I")
+8 ;
+9 ;For SNOMED look for preferred
+10 ;For UNII look for FSN
+11 ;For RXNORM look for preferred
+12 IF NMID=36
IF TYPE'="P"
QUIT
+13 IF NMID=5180
IF TYPE'="F"
QUIT
+14 IF NMID=1552
IF TYPE'="P"
QUIT
+15 IF NMID>32770
IF NMID<32780
IF TYPE'="F"
QUIT
+16 ;
+17 SET DESC=$$GET1^DIQ(9002318.3,TIEN_",",.02,"E")
+18 SET TERM=$$GET1^DIQ(9002318.3,TIEN_",",1,"E")
+19 SET DESC=DESC_U_TERM
End DoDot:1
IF DESC
QUIT
+20 ;
+21 QUIT DESC
+22 ;
FND(N,SEARCH,NMID) ;Set up return entry
+1 NEW ENT,CPT,FILTER,DESC,TERM,WGT,USEARCH,PC,UTERM
+2 SET CPT=$PIECE(^TMP("DILIST",$JOB,N,0),U,4)
IF CPT=""
QUIT
+3 SET ENT=$PIECE(^BSTS(9002318.4,CPT,0),"^",2)_"^"_$PIECE(^(0),"^",8)_"^"
+4 SET DESC=$PIECE(^TMP("DILIST",$JOB,N,0),U,3)
IF DESC=""
QUIT
+5 SET TERM=$PIECE(^TMP("DILIST",$JOB,N,0),U,6)
+6 ;
+7 SET FILTER=0
+8 ;
+9 ;Skip FSN terms and out of date entries
+10 Begin DoDot:1
+11 NEW TIEN,TTYP
+12 SET TIEN=$ORDER(^BSTS(9002318.3,"D",INMID,DESC,""))
IF TIEN=""
QUIT
+13 SET TTYP=$$GET1^DIQ(9002318.3,TIEN_",",.09,"I")
+14 ;I TTYP="F" S FILTER=1
+15 IF ((NMID<32771)!(NMID>32780))
IF TTYP="F"
SET FILTER=1
QUIT
+16 IF $$GET1^DIQ(9002318.3,TIEN_",",.11,"I")="Y"
SET FILTER=1
End DoDot:1
IF FILTER
QUIT
+17 ;
+18 ;Implement AND logic - must have all terms
+19 Begin DoDot:1
+20 NEW PC
+21 FOR PC=1:1:$LENGTH(SEARCH," ")
Begin DoDot:2
+22 NEW WD
+23 SET WD=$PIECE(SEARCH," ",PC)
+24 ;
+25 ;Strip out comparison words
+26 IF (WD="")!(WD="OR")!(WD="AND")!(WD="NOT")
QUIT
+27 IF ($$UP^XLFSTR(TERM))'[($$UP^XLFSTR(WD))
SET FILTER=1
End DoDot:2
IF FILTER
QUIT
End DoDot:1
IF FILTER
QUIT
+28 ;
+29 ;Determine weight value (look for exact match)
+30 SET USEARCH=$$UP^XLFSTR(SEARCH)
+31 SET UTERM=$$UP^XLFSTR(TERM)
+32 SET WGT=1
FOR PC=1:1:$LENGTH(USEARCH," ")
IF $PIECE(USEARCH," ",PC)=$PIECE(UTERM," ",PC)
SET WGT=WGT+1
+33 IF UTERM=USEARCH
SET WGT=WGT+5
+34 ;
+35 ;Log entry
+36 IF STYPE="F"
SET DESC=$PIECE($$PDESC^BSTSSRCH(CPT),U)
IF DESC=""
QUIT
+37 SET ENT=ENT_DESC
+38 SET @TMP@(ENT)=$GET(@TMP@(ENT))+WGT
+39 ;
+40 QUIT
+41 ;
FLD ;;
+1 ;;SEARCH^SEARCH
+2 ;;STYPE^STYPE
+3 ;;NAMESPACEID^NMID
+4 ;;SUBSET^SUB
+5 ;;SNAPDT^SNAPDT
+6 ;;MAXRECS^MAX
+7 ;;BCTCHRC^BCTCHRC
+8 ;;BCTCHCT^BCTCHCT
+9 ;;DEBUG^DEBUG
+10 QUIT
+11 ;
SXF ;EP - Set cross-reference
+1 SET %1=1
FOR %=1:1:$LENGTH(X)+1
Begin DoDot:1
+2 SET I=$EXTRACT(X,%)
+3 IF "(,.?! '/&:;)"[I
SET I=$EXTRACT($EXTRACT(X,%1,%-1),1,30)
SET %1=%+1
+4 SET I=$$UP^XLFSTR(I)
+5 IF $LENGTH(I)>2
IF ^DD("KWIC")'[I
Begin DoDot:2
+6 NEW CDSET
+7 SET CDSET=$$GET1^DIQ(9002318.3,DA_",",.08,"E")
IF CDSET=""
QUIT
+8 ;
+9 ;Strip leading '-'/'+'
+10 IF "-+"[$EXTRACT(I,1)
SET I=$EXTRACT(I,2,9999)
+11 ;
+12 ;Strip quotes
+13 SET I=$TRANSLATE(I,"""","")
+14 ;
+15 ;Save entry
+16 SET ^BSTS(9002318.3,"E",CDSET,I,DA)=""
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
KXF ;EP - Kill cross-reference
+1 SET %1=1
FOR %=1:1:$LENGTH(X)+1
Begin DoDot:1
+2 SET I=$EXTRACT(X,%)
+3 IF "(,.?! '/&:;)"[I
SET I=$EXTRACT($EXTRACT(X,%1,%-1),1,30)
SET %1=%+1
+4 SET I=$$UP^XLFSTR(I)
+5 IF $LENGTH(I)>2
Begin DoDot:2
+6 NEW CDSET
+7 SET CDSET=$$GET1^DIQ(9002318.3,DA_",",.08,"E")
IF CDSET=""
QUIT
+8 ;
+9 ;Strip leading '-'/'+'
+10 IF "-+"[$EXTRACT(I,1)
SET I=$EXTRACT(I,2,9999)
+11 ;
+12 ;Strip quotes
+13 SET I=$TRANSLATE(I,"""","")
+14 ;
+15 ;Kill entry
+16 KILL ^BSTS(9002318.3,"E",CDSET,I,DA)
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
DETAIL(OUT,BSTSWS,RESULT) ;EP - Return Details for each Concept/Term
+1 ;
+2 ;Return the concept detail
+3 ;
+4 ;Call moved to new routine because of space issues
+5 QUIT $$DETAIL^BSTSCDET(OUT,.BSTSWS,.RESULT)
