BSTSAPID ;GDIT/HS/BEE-Standard Terminology API Program ; 5 Nov 2012 9:53 AM
;;2.0;IHS STANDARD TERMINOLOGY;**1**;Dec 01, 2016;Build 36
;
Q
;
I10ADV(OUT,IN) ;EP - Returns Formatted ICD-10 mapping information for a specified Concept Id
;
;Input
; OUT - Output variable/global to return information in (VAR)
; IN - P1 - The Concept Id to look up
; - P2 (Optional) - LOCAL - Pass 1 or blank to perform local listing,
; Pass 2 for remote DTS listing
; - P3 (Optional) - DEBUG - Pass 1 to display debug information
;
;Output
; Function returns - [1]^[2]^[3]
; [1] - 2:Remote information returned
; 1:Local information returned
; 0:No Information Returned
; [2] - Primary Remote Error Message
; [3] - Secondary Remote Error Message (if applicable)
;
; OUT(#) - Array of formatted information to display for the concept
;
NEW CONCID,LOCAL,DEBUG,STS,MADV,I10ADV,LCNT,II,GRP,PRI,RULE
;
S CONCID=$P(IN,U) I CONCID="" Q "0^Invalid Concept Id"
S LOCAL=$P(IN,U,2)
S DEBUG=$P(IN,U,3)
S LCNT=0
;
K @OUT
;
;Make call to get the advice
S STS=$$MPADVICE^BSTSAPI("MADV",CONCID_U_LOCAL_U_U_DEBUG)
;
;Sort by group and priority
S II="" F S II=$O(MADV(II)) Q:II="" D
. ;
. S GRP=+$G(MADV(II,"MPGRP","VAL"))
. S PRI=+$G(MADV(II,"MPPRI","VAL"))
. M I10ADV(GRP,PRI,II)=MADV(II)
;
;Loop through and process
S RULE=0,GRP="" F S GRP=$O(I10ADV(GRP)) Q:GRP="" S PRI="" F S PRI=$O(I10ADV(GRP,PRI)) Q:PRI="" S II="" F S II=$O(I10ADV(GRP,PRI,II)) Q:II="" D
. ;
. NEW TGT,TRL,MPA,MPCNT,MPAV,MGRP
. ;
. ;BSTS*2.0*1;Added Map Group
. S MGRP=$G(I10ADV(GRP,PRI,II,"MPGRP","VAL")) S:MGRP="" MGRP="N/A"
. ;
. ;Get Target
. S TGT=$G(I10ADV(GRP,PRI,II,"MPTGT","VAL")) S:TGT="" TGT="N/A"
. I LCNT>0 S LCNT=LCNT+1,@OUT@(LCNT)=" "
. S RULE=RULE+1
. S LCNT=LCNT+1,@OUT@(LCNT)="Rule #"_RULE_$S($L(RULE)=1:" ",1:" ")_"Map Group: "_MGRP_" Target Code: "_TGT
. ;
. ;Get Advice
. S MPA=$G(I10ADV(GRP,PRI,II,"MPADV","VAL"))
. F MPCNT=1:1:$L(MPA," | ") S MPAV=$P(MPA," | ",MPCNT) I MPAV]"" D
.. I MPAV="MAP OF SOURCE CONCEPT IS CONTEXT DEPENDENT" Q ;Filter out unneeded advice
.. S LCNT=LCNT+1,@OUT@(LCNT)=MPAV
;
;Check for no advice
I LCNT=0 S LCNT=1,@OUT@(LCNT)="No mapping advice available"
;
Q STS
;
ICD2SMD(OUT,IN) ;EP - Return ICD9 to SNOMED mappings
;
;Input
; OUT - Output variable/global to return information in (VAR)
; IN - P1 - ICD9 Code
; - P2 (Optional) - Return Info (P-Preferred,S-Synonym,B-Subset,I-IsA
; X-ICD9/ICD10,C-Children) (Default is Subset, ICD, IsA and Children - "BXCI")
; - P3 (Optional) - LOCAL - Pass 1 or blank to perform local listing,
; Pass 2 for remote DTS listing
; - P4 (Optional) - DEBUG - Pass 1 to display debug information
; - P5 (Optional) - Date to search on (FileMan format - Default to DT)
;
;Output
; Function returns - [1]^[2]^[3]
; [1] - 2:Remote information returned
; 1:Local information returned
; 0:No Information Returned
; [2] - Primary Remote Error Message
; [3] - Secondary Remote Error Message (if applicable)
;
; VAR(#) - List of Records
;
; The VAR(#) list of records returns the following sections
; (based on the input piece 6 and 7 values):
;
;Concept ID/DTSID
; VAR(#,"CON")=Concept Id
; VAR(#,"DTS")=Internal DTS Id
;
;Fully Specified Name
; VAR(#,"FSN","DSC")=Description Id of the FSN
; VAR(#,"FSN","TRM")=Fully Specified Name
; VAR(#,"FSN","XADT")=Date Added
; VAR(#,"FSN","XRDT")=Date Retired
;
;ICD Mapping Information - Multiple Records Returned (CTR)
; VAR(#,"ICD",CTR,"COD")=ICD9/ICD10 Code
; VAR(#,"ICD",CTR,"TYP")=Code Type(ICD)
; VAR(#,"ICD",CTR,"XADT")=Date Added
; VAR(#,"ICD",CTR,"XRDT")=Date Retired
;
;IsA Information - Multiple Records Returned (CTR)
; VAR(#,"ISA",CTR,"CON")=Concept Id of IsA Term (may be blank prior to detail lookup)
; VAR(#,"ISA",CTR,"DTS")=DTSId of the IsA Term
; VAR(#,"ISA",CTR,"TRM")=IsA Term Name
; VAR(#,"ISA",CTR,"XADT")=Date Added
; VAR(#,"ISA",CTR,"XRDT")=Date Retired
;
;Child Information - Multiple Records Returned (CTR)
; VAR(#,"CHD",CTR,"CON")=Concept Id of Child Term (may be blank prior to detail lookup)
; VAR(#,"CHD",CTR,"DTS")=DTSId of the Child Term
; VAR(#,"CHD",CTR,"TRM")=IsA Term Name
; VAR(#,"CHD",CTR,"XADT")=Date Added
; VAR(#,"CHD",CTR,"XRDT")=Date Retired
;
;Lookup Problem Column Value (Preferred Term Information for concept for Search Type
;[F] or Synonym or Preferred Term Information for Search Type [S])
;(Based on Search Type parameter - F/S)
; VAR(#,"PRB","DSC")=Description Id of a Pref Term (Type F) or Synonym/Pref Term (S)
; VAR(#,"PRB","TRM")=Preferred Name of a Concept (F) or a Synonym/Preferred Name (S)
;
;Preferred Term Information
; VAR(#,"PRE","DSC")=Description ID of Preferred Term
; VAR(#,"PRE","TRM")=Preferred Term
; VAR(#,"PRE","XADT")=Date Added
; VAR(#,"PRE","XRDT")=Date Retired
;
;Subset Information - Multiple Records Returned (CTR)
; VAR(#,"SUB",CTR,"SUB")=Subset Name
; VAR(#,"SUB",CTR,"XADT")=Date Added
; VAR(#,"SUB",CTR,"XRDT")=Date Retired
;
;Synonym Information - Multiple Records Returned (CTR)
; VAR(#,"SYN",CTR,"DSC")=Description ID of Synonym
; VAR(#,"SYN",CTR,"TRM")=Synonym Term
; VAR(#,"SYN",CTR,"XADT")=Date Added
; VAR(#,"SYN",CTR,"XRDT")=Date Retired
;
;Date Concept Added/Retired
; VAR(#,"XADT")=Date Added
; VAR(#,"XRDT")=Date Retired
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSAPIC D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
N SEARCH,STYPE,NMID,SUB,SNAPDT,MAX,BCTCHRC,BCTCHCT,LOCAL,%D
N RESULT,DEBUG,BSTSR,BSTSI,RET,DAT,BSTSWS,BSTSD,X,%,%H,INDATE
K @OUT
;
I $G(DT)="" D DT^DICRW
S IN=$G(IN,"")
S SEARCH=$P(IN,U) Q:($TR(SEARCH," ")="") "0^Invalid Search String"
S NMID=36
S SNAPDT=$P(IN,U,5) S:SNAPDT="" SNAPDT=DT
S SNAPDT=SNAPDT_".2400"
S INDATE=$P(SNAPDT,".")
S SNAPDT=$$FMDT2XML^BSTSUTIL(SNAPDT)
S MAX=10000
S RET=$P(IN,U,2) S:RET="" RET="BXCI"
S DAT=1
S BCTCHRC=""
S BCTCHCT=""
S LOCAL=$P(IN,U,3),LOCAL=$S(LOCAL=2:"",1:"1")
S DEBUG=$P(IN,U,4),DEBUG=$S(DEBUG=1:"1",1:"")
;
S BSTSWS("SEARCH")=SEARCH
S BSTSWS("NAMESPACEID")=NMID
S BSTSWS("SNAPDT")=SNAPDT
S BSTSWS("INDATE")=INDATE
S BSTSWS("MAXRECS")=MAX
S BSTSWS("BCTCHRC")=BCTCHRC
S BSTSWS("BCTCHCT")=BCTCHCT
S BSTSWS("RET")=RET
S BSTSWS("DAT")=DAT
;
S BSTSI=0
;
;Make DTS search call
S BSTSR=1
;
;DTS Call
I LOCAL'=1 S BSTSR=$$ICD2SMD^BSTSWSV("RESULT",.BSTSWS,DEBUG) S:+BSTSR $P(BSTSR,U)=2
;
;If no results, try performing local search
I $D(RESULT)<10 S BSTSD=$$ICD2SMD^BSTSAPIF("RESULT",BSTSWS("SEARCH")) S:+BSTSD $P(BSTSR,U)=+BSTSD
;
;If no results and local, try performing DTS search
I $D(RESULT)<10,LOCAL S BSTSR=$$ICD2SMD^BSTSWSV("RESULT",.BSTSWS,DEBUG) S:+BSTSR $P(BSTSR,U)=2
;
;Loop through search results and retrieve detail
S BSTSWS("STYPE")="F"
S BSTSD=$$DETAIL^BSTSSRCH(OUT,.BSTSWS,.RESULT)
S $P(BSTSR,U)=$S(BSTSD=0:0,(+BSTSR)>0:+BSTSR,1:1)
Q BSTSR
;
CVRSN(OUT,IN) ;EP - Return the Current Version For the Code Set
;
;Input
; OUT - Output variable/global to return information in (VAR)
; IN - P1 (Optional) - The code set Id (default SNOMED US EXT '36')
; IN - P2 (Optional) - LOCAL - Pass 1 to perform local listing, otherwise leave
; blank for remote listing
; - P3 (Optional) - DEBUG - Pass 1 to display debug information
;
;Output
; Function returns - [1]^[2]^[3]
; [1] - 2:Remote information returned
; 1:Local information returned
; 0:No Information Returned
; [2] - Primary Remote Error Message
; [3] - Secondary Remote Error Message (if applicable)
;
; Single VAR record is returned
; @VAR = [1]^[2]^[3]^[4]
; [1] - Version Id
; [2] - Version Name
; [3] - Version Release Date
; [4] - Version Install Date (if available)
;
N LOCAL,DEBUG,BSTSR,NMID,NMIEN,BSTSI,VRID,X,%,%H,%D
K @OUT
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSAPID D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
I $G(DT)="" D DT^DICRW
S IN=$G(IN,"")
S NMID=$P(IN,U) S:NMID="" NMID=36 S:NMID=30 NMID=36
S LOCAL=$P(IN,U,2),LOCAL=$S(LOCAL=1:"1",1:"")
S DEBUG=$P(IN,U,3),DEBUG=$S(DEBUG=1:"1",1:"")
;
S BSTSI=0
;
;Make update call
S BSTSR=1
I LOCAL'=1,NMID S BSTSR=$$GVRSET^BSTSWSV(NMID,DEBUG) S:+BSTSR $P(BSTSR,U)=2
;
;Loop through files and retrieve result
S NMIEN=$O(^BSTS(9002318.1,"B",NMID,""))
I NMIEN]"" S VRID=$O(^BSTS(9002318.1,NMIEN,1,"B",""),-1) I VRID]"" D
. N VRIEN
. S VRIEN=$O(^BSTS(9002318.1,NMIEN,1,"B",VRID,""),-1) I VRIEN]"" D
.. NEW VRNAME,VRRLDT,VRINDT,DA,IENS
.. S DA(1)=NMIEN,DA=VRIEN,IENS=$$IENS^DILF(.DA)
.. S VRNAME=$$GET1^DIQ(9002318.11,IENS,.02,"E") Q:VRNAME=""
.. S VRRLDT=$$FMTE^XLFDT($$GET1^DIQ(9002318.11,IENS,.03,"I"),"5D")
.. S VRINDT=$$FMTE^XLFDT($$GET1^DIQ(9002318.11,IENS,.04,"I"),"5D")
.. S @OUT=VRID_U_VRNAME_U_VRRLDT_U_VRINDT
S $P(BSTSR,U)=$S(@OUT="":0,(+BSTSR)>0:+BSTSR,1:1)
Q BSTSR
;
ERR ;
D ^%ZTER
Q
BSTSAPID ;GDIT/HS/BEE-Standard Terminology API Program ; 5 Nov 2012 9:53 AM
+1 ;;2.0;IHS STANDARD TERMINOLOGY;**1**;Dec 01, 2016;Build 36
+2 ;
+3 QUIT
+4 ;
I10ADV(OUT,IN) ;EP - Returns Formatted ICD-10 mapping information for a specified Concept Id
+1 ;
+2 ;Input
+3 ; OUT - Output variable/global to return information in (VAR)
+4 ; IN - P1 - The Concept Id to look up
+5 ; - P2 (Optional) - LOCAL - Pass 1 or blank to perform local listing,
+6 ; Pass 2 for remote DTS listing
+7 ; - P3 (Optional) - DEBUG - Pass 1 to display debug information
+8 ;
+9 ;Output
+10 ; Function returns - [1]^[2]^[3]
+11 ; [1] - 2:Remote information returned
+12 ; 1:Local information returned
+13 ; 0:No Information Returned
+14 ; [2] - Primary Remote Error Message
+15 ; [3] - Secondary Remote Error Message (if applicable)
+16 ;
+17 ; OUT(#) - Array of formatted information to display for the concept
+18 ;
+19 NEW CONCID,LOCAL,DEBUG,STS,MADV,I10ADV,LCNT,II,GRP,PRI,RULE
+20 ;
+21 SET CONCID=$PIECE(IN,U)
IF CONCID=""
QUIT "0^Invalid Concept Id"
+22 SET LOCAL=$PIECE(IN,U,2)
+23 SET DEBUG=$PIECE(IN,U,3)
+24 SET LCNT=0
+25 ;
+26 KILL @OUT
+27 ;
+28 ;Make call to get the advice
+29 SET STS=$$MPADVICE^BSTSAPI("MADV",CONCID_U_LOCAL_U_U_DEBUG)
+30 ;
+31 ;Sort by group and priority
+32 SET II=""
FOR
SET II=$ORDER(MADV(II))
IF II=""
QUIT
Begin DoDot:1
+33 ;
+34 SET GRP=+$GET(MADV(II,"MPGRP","VAL"))
+35 SET PRI=+$GET(MADV(II,"MPPRI","VAL"))
+36 MERGE I10ADV(GRP,PRI,II)=MADV(II)
End DoDot:1
+37 ;
+38 ;Loop through and process
+39 SET RULE=0
SET GRP=""
FOR
SET GRP=$ORDER(I10ADV(GRP))
IF GRP=""
QUIT
SET PRI=""
FOR
SET PRI=$ORDER(I10ADV(GRP,PRI))
IF PRI=""
QUIT
SET II=""
FOR
SET II=$ORDER(I10ADV(GRP,PRI,II))
IF II=""
QUIT
Begin DoDot:1
+40 ;
+41 NEW TGT,TRL,MPA,MPCNT,MPAV,MGRP
+42 ;
+43 ;BSTS*2.0*1;Added Map Group
+44 SET MGRP=$GET(I10ADV(GRP,PRI,II,"MPGRP","VAL"))
IF MGRP=""
SET MGRP="N/A"
+45 ;
+46 ;Get Target
+47 SET TGT=$GET(I10ADV(GRP,PRI,II,"MPTGT","VAL"))
IF TGT=""
SET TGT="N/A"
+48 IF LCNT>0
SET LCNT=LCNT+1
SET @OUT@(LCNT)=" "
+49 SET RULE=RULE+1
+50 SET LCNT=LCNT+1
SET @OUT@(LCNT)="Rule #"_RULE_$SELECT($LENGTH(RULE)=1:" ",1:" ")_"Map Group: "_MGRP_" Target Code: "_TGT
+51 ;
+52 ;Get Advice
+53 SET MPA=$GET(I10ADV(GRP,PRI,II,"MPADV","VAL"))
+54 FOR MPCNT=1:1:$LENGTH(MPA," | ")
SET MPAV=$PIECE(MPA," | ",MPCNT)
IF MPAV]""
Begin DoDot:2
+55 ;Filter out unneeded advice
IF MPAV="MAP OF SOURCE CONCEPT IS CONTEXT DEPENDENT"
QUIT
+56 SET LCNT=LCNT+1
SET @OUT@(LCNT)=MPAV
End DoDot:2
End DoDot:1
+57 ;
+58 ;Check for no advice
+59 IF LCNT=0
SET LCNT=1
SET @OUT@(LCNT)="No mapping advice available"
+60 ;
+61 QUIT STS
+62 ;
ICD2SMD(OUT,IN) ;EP - Return ICD9 to SNOMED mappings
+1 ;
+2 ;Input
+3 ; OUT - Output variable/global to return information in (VAR)
+4 ; IN - P1 - ICD9 Code
+5 ; - P2 (Optional) - Return Info (P-Preferred,S-Synonym,B-Subset,I-IsA
+6 ; X-ICD9/ICD10,C-Children) (Default is Subset, ICD, IsA and Children - "BXCI")
+7 ; - P3 (Optional) - LOCAL - Pass 1 or blank to perform local listing,
+8 ; Pass 2 for remote DTS listing
+9 ; - P4 (Optional) - DEBUG - Pass 1 to display debug information
+10 ; - P5 (Optional) - Date to search on (FileMan format - Default to DT)
+11 ;
+12 ;Output
+13 ; Function returns - [1]^[2]^[3]
+14 ; [1] - 2:Remote information returned
+15 ; 1:Local information returned
+16 ; 0:No Information Returned
+17 ; [2] - Primary Remote Error Message
+18 ; [3] - Secondary Remote Error Message (if applicable)
+19 ;
+20 ; VAR(#) - List of Records
+21 ;
+22 ; The VAR(#) list of records returns the following sections
+23 ; (based on the input piece 6 and 7 values):
+24 ;
+25 ;Concept ID/DTSID
+26 ; VAR(#,"CON")=Concept Id
+27 ; VAR(#,"DTS")=Internal DTS Id
+28 ;
+29 ;Fully Specified Name
+30 ; VAR(#,"FSN","DSC")=Description Id of the FSN
+31 ; VAR(#,"FSN","TRM")=Fully Specified Name
+32 ; VAR(#,"FSN","XADT")=Date Added
+33 ; VAR(#,"FSN","XRDT")=Date Retired
+34 ;
+35 ;ICD Mapping Information - Multiple Records Returned (CTR)
+36 ; VAR(#,"ICD",CTR,"COD")=ICD9/ICD10 Code
+37 ; VAR(#,"ICD",CTR,"TYP")=Code Type(ICD)
+38 ; VAR(#,"ICD",CTR,"XADT")=Date Added
+39 ; VAR(#,"ICD",CTR,"XRDT")=Date Retired
+40 ;
+41 ;IsA Information - Multiple Records Returned (CTR)
+42 ; VAR(#,"ISA",CTR,"CON")=Concept Id of IsA Term (may be blank prior to detail lookup)
+43 ; VAR(#,"ISA",CTR,"DTS")=DTSId of the IsA Term
+44 ; VAR(#,"ISA",CTR,"TRM")=IsA Term Name
+45 ; VAR(#,"ISA",CTR,"XADT")=Date Added
+46 ; VAR(#,"ISA",CTR,"XRDT")=Date Retired
+47 ;
+48 ;Child Information - Multiple Records Returned (CTR)
+49 ; VAR(#,"CHD",CTR,"CON")=Concept Id of Child Term (may be blank prior to detail lookup)
+50 ; VAR(#,"CHD",CTR,"DTS")=DTSId of the Child Term
+51 ; VAR(#,"CHD",CTR,"TRM")=IsA Term Name
+52 ; VAR(#,"CHD",CTR,"XADT")=Date Added
+53 ; VAR(#,"CHD",CTR,"XRDT")=Date Retired
+54 ;
+55 ;Lookup Problem Column Value (Preferred Term Information for concept for Search Type
+56 ;[F] or Synonym or Preferred Term Information for Search Type [S])
+57 ;(Based on Search Type parameter - F/S)
+58 ; VAR(#,"PRB","DSC")=Description Id of a Pref Term (Type F) or Synonym/Pref Term (S)
+59 ; VAR(#,"PRB","TRM")=Preferred Name of a Concept (F) or a Synonym/Preferred Name (S)
+60 ;
+61 ;Preferred Term Information
+62 ; VAR(#,"PRE","DSC")=Description ID of Preferred Term
+63 ; VAR(#,"PRE","TRM")=Preferred Term
+64 ; VAR(#,"PRE","XADT")=Date Added
+65 ; VAR(#,"PRE","XRDT")=Date Retired
+66 ;
+67 ;Subset Information - Multiple Records Returned (CTR)
+68 ; VAR(#,"SUB",CTR,"SUB")=Subset Name
+69 ; VAR(#,"SUB",CTR,"XADT")=Date Added
+70 ; VAR(#,"SUB",CTR,"XRDT")=Date Retired
+71 ;
+72 ;Synonym Information - Multiple Records Returned (CTR)
+73 ; VAR(#,"SYN",CTR,"DSC")=Description ID of Synonym
+74 ; VAR(#,"SYN",CTR,"TRM")=Synonym Term
+75 ; VAR(#,"SYN",CTR,"XADT")=Date Added
+76 ; VAR(#,"SYN",CTR,"XRDT")=Date Retired
+77 ;
+78 ;Date Concept Added/Retired
+79 ; VAR(#,"XADT")=Date Added
+80 ; VAR(#,"XRDT")=Date Retired
+81 ;
+82 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BSTSAPIC D UNWIND^%ZTER"
+83 ;
+84 NEW SEARCH,STYPE,NMID,SUB,SNAPDT,MAX,BCTCHRC,BCTCHCT,LOCAL,%D
+85 NEW RESULT,DEBUG,BSTSR,BSTSI,RET,DAT,BSTSWS,BSTSD,X,%,%H,INDATE
+86 KILL @OUT
+87 ;
+88 IF $GET(DT)=""
DO DT^DICRW
+89 SET IN=$GET(IN,"")
+90 SET SEARCH=$PIECE(IN,U)
IF ($TRANSLATE(SEARCH," ")="")
QUIT "0^Invalid Search String"
+91 SET NMID=36
+92 SET SNAPDT=$PIECE(IN,U,5)
IF SNAPDT=""
SET SNAPDT=DT
+93 SET SNAPDT=SNAPDT_".2400"
+94 SET INDATE=$PIECE(SNAPDT,".")
+95 SET SNAPDT=$$FMDT2XML^BSTSUTIL(SNAPDT)
+96 SET MAX=10000
+97 SET RET=$PIECE(IN,U,2)
IF RET=""
SET RET="BXCI"
+98 SET DAT=1
+99 SET BCTCHRC=""
+100 SET BCTCHCT=""
+101 SET LOCAL=$PIECE(IN,U,3)
SET LOCAL=$SELECT(LOCAL=2:"",1:"1")
+102 SET DEBUG=$PIECE(IN,U,4)
SET DEBUG=$SELECT(DEBUG=1:"1",1:"")
+103 ;
+104 SET BSTSWS("SEARCH")=SEARCH
+105 SET BSTSWS("NAMESPACEID")=NMID
+106 SET BSTSWS("SNAPDT")=SNAPDT
+107 SET BSTSWS("INDATE")=INDATE
+108 SET BSTSWS("MAXRECS")=MAX
+109 SET BSTSWS("BCTCHRC")=BCTCHRC
+110 SET BSTSWS("BCTCHCT")=BCTCHCT
+111 SET BSTSWS("RET")=RET
+112 SET BSTSWS("DAT")=DAT
+113 ;
+114 SET BSTSI=0
+115 ;
+116 ;Make DTS search call
+117 SET BSTSR=1
+118 ;
+119 ;DTS Call
+120 IF LOCAL'=1
SET BSTSR=$$ICD2SMD^BSTSWSV("RESULT",.BSTSWS,DEBUG)
IF +BSTSR
SET $PIECE(BSTSR,U)=2
+121 ;
+122 ;If no results, try performing local search
+123 IF $DATA(RESULT)<10
SET BSTSD=$$ICD2SMD^BSTSAPIF("RESULT",BSTSWS("SEARCH"))
IF +BSTSD
SET $PIECE(BSTSR,U)=+BSTSD
+124 ;
+125 ;If no results and local, try performing DTS search
+126 IF $DATA(RESULT)<10
IF LOCAL
SET BSTSR=$$ICD2SMD^BSTSWSV("RESULT",.BSTSWS,DEBUG)
IF +BSTSR
SET $PIECE(BSTSR,U)=2
+127 ;
+128 ;Loop through search results and retrieve detail
+129 SET BSTSWS("STYPE")="F"
+130 SET BSTSD=$$DETAIL^BSTSSRCH(OUT,.BSTSWS,.RESULT)
+131 SET $PIECE(BSTSR,U)=$SELECT(BSTSD=0:0,(+BSTSR)>0:+BSTSR,1:1)
+132 QUIT BSTSR
+133 ;
CVRSN(OUT,IN) ;EP - Return the Current Version For the Code Set
+1 ;
+2 ;Input
+3 ; OUT - Output variable/global to return information in (VAR)
+4 ; IN - P1 (Optional) - The code set Id (default SNOMED US EXT '36')
+5 ; IN - P2 (Optional) - LOCAL - Pass 1 to perform local listing, otherwise leave
+6 ; blank for remote listing
+7 ; - P3 (Optional) - DEBUG - Pass 1 to display debug information
+8 ;
+9 ;Output
+10 ; Function returns - [1]^[2]^[3]
+11 ; [1] - 2:Remote information returned
+12 ; 1:Local information returned
+13 ; 0:No Information Returned
+14 ; [2] - Primary Remote Error Message
+15 ; [3] - Secondary Remote Error Message (if applicable)
+16 ;
+17 ; Single VAR record is returned
+18 ; @VAR = [1]^[2]^[3]^[4]
+19 ; [1] - Version Id
+20 ; [2] - Version Name
+21 ; [3] - Version Release Date
+22 ; [4] - Version Install Date (if available)
+23 ;
+24 NEW LOCAL,DEBUG,BSTSR,NMID,NMIEN,BSTSI,VRID,X,%,%H,%D
+25 KILL @OUT
+26 ;
+27 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BSTSAPID D UNWIND^%ZTER"
+28 ;
+29 IF $GET(DT)=""
DO DT^DICRW
+30 SET IN=$GET(IN,"")
+31 SET NMID=$PIECE(IN,U)
IF NMID=""
SET NMID=36
IF NMID=30
SET NMID=36
+32 SET LOCAL=$PIECE(IN,U,2)
SET LOCAL=$SELECT(LOCAL=1:"1",1:"")
+33 SET DEBUG=$PIECE(IN,U,3)
SET DEBUG=$SELECT(DEBUG=1:"1",1:"")
+34 ;
+35 SET BSTSI=0
+36 ;
+37 ;Make update call
+38 SET BSTSR=1
+39 IF LOCAL'=1
IF NMID
SET BSTSR=$$GVRSET^BSTSWSV(NMID,DEBUG)
IF +BSTSR
SET $PIECE(BSTSR,U)=2
+40 ;
+41 ;Loop through files and retrieve result
+42 SET NMIEN=$ORDER(^BSTS(9002318.1,"B",NMID,""))
+43 IF NMIEN]""
SET VRID=$ORDER(^BSTS(9002318.1,NMIEN,1,"B",""),-1)
IF VRID]""
Begin DoDot:1
+44 NEW VRIEN
+45 SET VRIEN=$ORDER(^BSTS(9002318.1,NMIEN,1,"B",VRID,""),-1)
IF VRIEN]""
Begin DoDot:2
+46 NEW VRNAME,VRRLDT,VRINDT,DA,IENS
+47 SET DA(1)=NMIEN
SET DA=VRIEN
SET IENS=$$IENS^DILF(.DA)
+48 SET VRNAME=$$GET1^DIQ(9002318.11,IENS,.02,"E")
IF VRNAME=""
QUIT
+49 SET VRRLDT=$$FMTE^XLFDT($$GET1^DIQ(9002318.11,IENS,.03,"I"),"5D")
+50 SET VRINDT=$$FMTE^XLFDT($$GET1^DIQ(9002318.11,IENS,.04,"I"),"5D")
+51 SET @OUT=VRID_U_VRNAME_U_VRRLDT_U_VRINDT
End DoDot:2
End DoDot:1
+52 SET $PIECE(BSTSR,U)=$SELECT(@OUT="":0,(+BSTSR)>0:+BSTSR,1:1)
+53 QUIT BSTSR
+54 ;
ERR ;
+1 DO ^%ZTER
+2 QUIT
