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

BSTSAPIA.m

Go to the documentation of this file. 
  1. BSTSAPIA ;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
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1.  ;Input
  1.  ; OUT - Output variable/global to return information in (VAR)
  1.  ;  IN - P1 - Search string
  1.  ;     - P2 - Search Type - (F-Fully specified name, S-Synonyms)
  1.  ;     - P3 (Optional) - Namespace ID - Default to SNOMED US EXT (#36)
  1.  ;                     ID      NAME
  1.  ;                     5180    FDA UNII
  1.  ;                     32773   GMRA Allergies with Maps
  1.  ;                     32772   GMRA Signs Symptoms
  1.  ;                     32771   IHS VANDF
  1.  ;                     32774   IHS Med Route
  1.  ;                     32770   ECLIPS
  1.  ;                     1552    RxNorm R
  1.  ;                     36      SNOMED CT US Extension
  1.  ; 
  1.  ;     - P4 (Optional) - Subset(s) to filter on (delimited by "~")
  1.  ;                       If blank default to "IHS Problem List". For SNOMED lookups
  1.  ;                       passing "ALL" searches on all available SNOMED terms.
  1.  ;     - P5 (Optional) - Date to check (default to DT)
  1.  ;     - P6 (Optional) - Maximum number of concepts/terms to return (default 25)
  1.  ;     - P7 (Optional) - Return Info (P-Preferred,S-Synonym,B-Subset,I-IsA
  1.  ;                       X-ICD9/ICD10,C-Children,A-Associations,V-Inv Assoc)
  1.  ;                       (Default is all - "PSBIXCAV")
  1.  ;     - P8 (Optional) - Pass 1 to NOT return Add/Retire date info
  1.  ;     - P9 (Optional) - Batch Return - Start at record #
  1.  ;                       (used in conjunction with P7)
  1.  ;     - P10 (Optional) - Batch Return - # of concepts to return per batch
  1.  ;                       (used in conjunction with P6)
  1.  ;     - P11 (Optional) - LOCAL - Pass 1 to perform local listing, otherwise leave
  1.  ;                        blank for remote listing
  1.  ;     - P12 (Optional) - DEBUG - Pass 1 to display debug information
  1.  ;     - P13 (Optional) - Mapping Parameters - Ex. EPI=288527008;VST=2087394;AF=With;PRB=50239
  1.  ;
  1.  ;Output
  1.  ; Function returns - [1]^[2]^[3]
  1.  ; [1] - 2:Remote information returned
  1.  ;       1:Local information returned
  1.  ;       0:No Information Returned
  1.  ; [2] - Primary Remote Error Message
  1.  ; [3] - Secondary Remote Error Message (if applicable)
  1.  ;
  1.  ; VAR(#) - List of Records
  1.  ; Please see routine BSTSCDET, tag DETAIL for a detailed description of the
  1.  ; information being returned by this API in VAR(#).
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSAPIA D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  N SEARCH,STYPE,NMID,SUB,SNAPDT,MAX,BCTCHRC,BCTCHCT,LOCAL,INDATE
  1.  N RESULT,DEBUG,BSTSR,BSTSI,RET,DAT,BSTSWS,BSTSD,X,%,%H,%D
  1.  K @OUT,STS
  1.  ;
  1.  I $G(DT)="" D DT^DICRW
  1.  S IN=$G(IN,"")
  1.  S SEARCH=$P(IN,U) Q:($TR(SEARCH," ")="") "0^Invalid Search String"
  1.  S STYPE=$P(IN,U,2) I STYPE'="F",STYPE'="S" Q "0^Invalid Search Type"
  1.  S NMID=$P(IN,U,3) S:NMID="" NMID=36 S:NMID=30 NMID=36
  1.  S SUB=$P(IN,U,4)
  1.  S SNAPDT=$P(IN,U,5) S:SNAPDT]"" SNAPDT=$$DATE^BSTSUTIL(SNAPDT)
  1.  S:SNAPDT="" SNAPDT=DT_".0001"
  1.  S INDATE=$P(SNAPDT,".")
  1.  S SNAPDT=$$FMTE^BSTSUTIL(SNAPDT)
  1.  S MAX=$P(IN,U,6) S:'MAX MAX=25
  1.  S RET=$P(IN,U,7) S:RET="" RET="PSBIXCAV"
  1.  S DAT=$P(IN,U,8)
  1.  S BCTCHRC=$P(IN,U,9)
  1.  S BCTCHCT=$P(IN,U,10) I BCTCHRC,'BCTCHCT S BCTCHCT=MAX
  1.  S LOCAL=$P(IN,U,11),LOCAL=$S(LOCAL=1:"1",1:"")
  1.  S DEBUG=$P(IN,U,12),DEBUG=$S(DEBUG=1:"1",1:"")
  1.  ;
  1.  ;Check for new version
  1.  D CHECK^BSTSVRSN
  1.  ;
  1.  S BSTSWS("SEARCH")=SEARCH
  1.  S BSTSWS("STYPE")=STYPE
  1.  S BSTSWS("NAMESPACEID")=NMID
  1.  S BSTSWS("SUBSET")=SUB
  1.  S BSTSWS("SNAPDT")=SNAPDT
  1.  S BSTSWS("INDATE")=INDATE
  1.  S BSTSWS("MAXRECS")=MAX
  1.  S BSTSWS("BCTCHRC")=BCTCHRC
  1.  S BSTSWS("BCTCHCT")=BCTCHCT
  1.  S BSTSWS("RET")=RET
  1.  S BSTSWS("DAT")=DAT
  1.  S BSTSWS("MPPRM")=$P(IN,U,6) ;BSTS*1.0*6;Mapping parameters
  1.  ;
  1.  S BSTSI=0
  1.  ;
  1.  ;Make DTS search call
  1.  S BSTSR=1
  1.  ;
  1.  ;BSTS*2.0*1;Log search string
  1.  D SEARCH^BSTSAPIL(.BSTSWS)
  1.  ;
  1.  ;DTS Call
  1.  I LOCAL'=1 S BSTSR=$$SEARCH^BSTSWSV("RESULT",.BSTSWS,DEBUG) S:+BSTSR $P(BSTSR,U)=2
  1.  ;
  1.  ;If no results, try performing local search
  1.  I $D(RESULT)<10 D
  1.  . ;
  1.  . ;Since in local, switch out of "ALL" search
  1.  . S:BSTSWS("SUBSET")="ALL" BSTSWS("SUBSET")="IHS PROBLEM ALL SNOMED"
  1.  . ;
  1.  . ;Make the local call
  1.  . S BSTSD=$$SRC^BSTSSRCH("RESULT",.BSTSWS)
  1.  ;
  1.  ;Loop through search results and retrieve detail
  1.  S BSTSD=$$DETAIL^BSTSSRCH(OUT,.BSTSWS,.RESULT)
  1.  S $P(BSTSR,U)=$S(BSTSD=0:0,(+BSTSR)>0:+BSTSR,1:1)
  1.  Q BSTSR
  1.  ;
  1. CODESETS(OUT,IN) ;EP - Return list of available codesets
  1.  ;
  1.  ;Input
  1.  ; OUT - Output variable/global to return information in (VAR)
  1.  ;  IN - P1 (Optional) - LOCAL - Pass 1 to perform local listing, otherwise leave
  1.  ;                       blank for remote listing
  1.  ;     - P2 (Optional) - DEBUG - Pass 1 to display debug information
  1.  ;
  1.  ;Output
  1.  ; Function returns - [1]^[2]^[3]
  1.  ; [1] - 2:Remote information returned
  1.  ;       1:Local information returned
  1.  ;       0:No Information Returned
  1.  ; [2] - Primary Remote Error Message
  1.  ; [3] - Secondary Remote Error Message (if applicable)
  1.  ;
  1.  ; VAR(#) - [1]^[2]^[3]
  1.  ; [1] - Codeset Id
  1.  ; [2] - Codeset Code
  1.  ; [3] - Codeset Name
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSAPIA D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  N LOCAL,DEBUG,BSTSR,CDCD,CDIEN,BSTSI,X,%,%H,%D
  1.  K @OUT
  1.  ;
  1.  I $G(DT)="" D DT^DICRW
  1.  S IN=$G(IN,"")
  1.  S LOCAL=$P(IN,U),LOCAL=$S(LOCAL=1:"1",1:"")
  1.  S DEBUG=$P(IN,U,2),DEBUG=$S(DEBUG=1:"1",1:"")
  1.  ;
  1.  S BSTSI=0
  1.  ;
  1.  ;Make update call
  1.  S BSTSR=1
  1.  I LOCAL'=1 S BSTSR=$$GCDSET^BSTSWSV(DEBUG) S:+BSTSR $P(BSTSR,U)=2
  1.  ;
  1.  ;Loop through files and retrieve results
  1.  S CDCD="" F  S CDCD=$O(^BSTS(9002318.1,"C",CDCD)) Q:CDCD=""  D
  1.  . S CDIEN="" F  S CDIEN=$O(^BSTS(9002318.1,"C",CDCD,CDIEN)) Q:CDIEN=""  D
  1.  .. NEW CDID,CDCODE,CDNAME
  1.  .. S CDID=$$GET1^DIQ(9002318.1,CDIEN_",",.01,"E") Q:CDID=""
  1.  .. S CDCODE=$$GET1^DIQ(9002318.1,CDIEN_",",.02,"E") Q:CDCODE=""
  1.  .. S CDNAME=$$GET1^DIQ(9002318.1,CDIEN_",",.03,"E")
  1.  .. S BSTSI=BSTSI+1,@OUT@(BSTSI)=CDID_U_CDCODE_U_CDNAME
  1.  S $P(BSTSR,U)=$S(BSTSI=0:0,(+BSTSR)>0:+BSTSR,1:1)
  1.  Q BSTSR
  1.  ;
  1. VERSIONS(OUT,IN) ;EP - Return a list of available versions for a code set
  1.  ;
  1.  ;Input
  1.  ; OUT - Output variable/global to return information in (VAR)
  1.  ;  IN - P1 (Optional) - Namespace ID - Default to SNOMED US EXT (#36)
  1.  ;     - P2 (Optional) - LOCAL - Pass 1 to perform local listing, otherwise leave
  1.  ;                       blank for remote listing
  1.  ;     - P3 (Optional) - DEBUG - Pass 1 to display debug information
  1.  ;
  1.  ;Output
  1.  ; Function returns - [1]^[2]^[3]
  1.  ; [1] - 2:Remote information returned
  1.  ;       1:Local information returned
  1.  ;       0:No Information Returned
  1.  ; [2] - Primary Remote Error Message
  1.  ; [3] - Secondary Remote Error Message (if applicable)
  1.  ;
  1.  ; VAR(#) - [1]^[2]^[3]^[4]
  1.  ; [1] - Version Id
  1.  ; [2] - Version Name
  1.  ; [3] - Version Release Date
  1.  ; [4] - Version Install Date (if available)
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSAPIA D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  N LOCAL,DEBUG,BSTSR,NMID,NMIEN,BSTSI,VRID,X,%,%H,%D
  1.  K @OUT
  1.  ;
  1.  I $G(DT)="" D DT^DICRW
  1.  S IN=$G(IN,"")
  1.  S NMID=$P(IN,U) S:NMID="" NMID=36 S:NMID=30 NMID=36
  1.  S LOCAL=$P(IN,U,2),LOCAL=$S(LOCAL=1:"1",1:"")
  1.  S DEBUG=$P(IN,U,3),DEBUG=$S(DEBUG=1:"1",1:"")
  1.  ;
  1.  S BSTSI=0
  1.  ;
  1.  ;Make update call
  1.  S BSTSR=1
  1.  I LOCAL'=1,NMID S BSTSR=$$GVRSET^BSTSWSV(NMID,DEBUG) S:+BSTSR $P(BSTSR,U)=2
  1.  ;
  1.  ;Loop through files and retrieve results
  1.  S NMIEN=$O(^BSTS(9002318.1,"B",NMID,""))
  1.  I NMIEN]"" S VRID="" F  S VRID=$O(^BSTS(9002318.1,NMIEN,1,"B",VRID)) Q:VRID=""  D
  1.  . N VRIEN
  1.  . S VRIEN="" F  S VRIEN=$O(^BSTS(9002318.1,NMIEN,1,"B",VRID,VRIEN)) Q:VRIEN=""  D
  1.  .. NEW VRNAME,VRRLDT,VRINDT,DA,IENS
  1.  .. S DA(1)=NMIEN,DA=VRIEN,IENS=$$IENS^DILF(.DA)
  1.  .. S VRNAME=$$GET1^DIQ(9002318.11,IENS,.02,"E") Q:VRNAME=""
  1.  .. S VRRLDT=$$FMTE^XLFDT($$GET1^DIQ(9002318.11,IENS,.03,"I"),"5D")
  1.  .. S VRINDT=$$FMTE^XLFDT($$GET1^DIQ(9002318.11,IENS,.04,"I"),"5D")
  1.  .. S BSTSI=BSTSI+1,@OUT@(BSTSI)=VRID_U_VRNAME_U_VRRLDT_U_VRINDT
  1.  S $P(BSTSR,U)=$S(BSTSI=0:0,(+BSTSR)>0:+BSTSR,1:1)
  1.  Q BSTSR
  1.  ;
  1. SUBSET(OUT,IN) ;EP - Return the list of subsets available for a Code Set
  1.  ;
  1.  ;
  1.  ;Input
  1.  ; OUT - Output variable/global to return information in (VAR)
  1.  ;  IN - P1 (Optional) - Namespace ID - Default to SNOMED US EXT (#36)
  1.  ;     - P2 (Optional) - LOCAL - Pass 1 OR leave blank to perform local listing,
  1.  ;                       Pass 2 for remote DTS listing
  1.  ;     - P3 (Optional) - DEBUG - Pass 1 to display debug information
  1.  ;
  1.  ;Output
  1.  ; Function returns - [1]^[2]
  1.  ; [1] - 2:Remote information returned
  1.  ;       1:Local information returned
  1.  ;       0:No Information Returned
  1.  ; [2] - Primary Remote Error Message
  1.  ; [3] - Secondary Remote Error Message (if applicable)
  1.  ;
  1.  ; VAR(#) - [1]
  1.  ; [1] - Subset
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSAPIA D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  N SUB,NMID,CNT,X,%,%H,RESULT,NMIEN,BSTSR,LOCAL,DEBUG,%D
  1.  K @OUT
  1.  ;
  1.  I $G(DT)="" D DT^DICRW
  1.  S IN=$G(IN,"")
  1.  S NMID=$P(IN,U) S:NMID="" NMID=36 S:NMID=30 NMID=36
  1.  S LOCAL=$P(IN,U,2),LOCAL=$S(LOCAL=2:"",1:"1")
  1.  S DEBUG=$P(IN,U,3),DEBUG=$S(DEBUG=1:"1",1:"")
  1.  ;
  1.  ;Make sure we have a codeset (namespace)
  1.  S NMIEN=$O(^BSTS(9002318.1,"B",NMID,"")) Q:NMIEN=""
  1.  ;
  1.  ;Make update call
  1.  S BSTSR=1
  1.  I LOCAL'=1,NMID S BSTSR=$$SUBSET^BSTSWSV("RESULT",NMID,DEBUG) S:+BSTSR $P(BSTSR,U)=2
  1.  I $D(RESULT)>9 M @OUT=RESULT
  1.  ;
  1.  ;If no results from call get from local
  1.  I $D(RESULT)<10 S $P(BSTSR,U)=1,SUB="",CNT=0 F  S SUB=$O(^BSTS(9002318.4,"E",NMIEN,SUB)) Q:SUB=""  D
  1.  . S CNT=CNT+1
  1.  . S @OUT@(CNT)=SUB
  1.  ;
  1.  ;Mark if no results
  1.  I $D(@OUT)<10 S $P(BSTSR,U)=0
  1.  Q BSTSR
  1.  ;
  1. DESC(IN) ;PEP - Returns detail information for a specified Description Id
  1.  ;
  1.  ;Input
  1.  ; OUT - Output variable/global to return information in (VAR)
  1.  ;  IN - P1 - The Description Id to look up
  1.  ;     - P2 (Optional) - The code set Id (default SNOMED US EXT '36')
  1.  ;     - P3 (Optional) - LOCAL - Pass 1 or blank to perform local listing,
  1.  ;                       Pass 2 for remote DTS listing
  1.  ;     - P4 (Optional) - DEBUG - Pass 1 to display debug information
  1.  ;     - P5 (Optional) - Snapshot Date to check (default DT)
  1.  ;
  1.  ;Output
  1.  ; Function returns - [1]^[2]
  1.  ; [1] - Concept Id
  1.  ; [2] - Term Description
  1.  ; [3] - Mapped ICD Values (based on P5 Snapshot Date)
  1.  ; [4] - Mapped ICD9 Values
  1.  ; [5] - Prompt for Abnormal/Normal Findings (1-Yes,0-No)
  1.  ; [6] - Prompt for Laterality (1-Yes,0-No)
  1.  ; [7] - Default status (Chronic, Personal History, Sub-acute, Admin, Social)
  1.  ; [8] - Prompt for Healing (RDNM, RDN, RD)
  1.  ; [9] - List of healing choices to display (ex. 717128007|NL Union;28087009|Delayed)
  1.  ;
  1.  ;BSTS*1.0*6;Added piece 5 output - prompt for abnormal findings
  1.  NEW VAR,RES,STS,ICD,IC,%D,IC9,ABN,LAT
  1.  S STS=$$DSCLKP^BSTSAPIB("VAR",$G(IN))
  1.  S RES=$G(VAR(1,"CON"))_U_$G(VAR(1,"PRB","TRM"))
  1.  ;
  1.  ;Tack on Mapped ICD values
  1.  ;
  1.  S ICD="",IC="" F  S IC=$O(VAR(1,"ICD",IC)) Q:IC=""  D
  1.  . NEW ICCOD
  1.  . S ICCOD=$G(VAR(1,"ICD",IC,"COD")) Q:IC=""
  1.  . S ICD=ICD_$S(ICD]"":";",1:"")_ICCOD
  1.  ;
  1.  ;Tack on ICD9 values
  1.  S IC9="",IC="" F  S IC=$O(VAR(1,"IC9",IC)) Q:IC=""  D
  1.  . NEW ICTYP,ICCOD
  1.  . S ICCOD=$G(VAR(1,"IC9",IC,"COD")) Q:IC=""
  1.  . S ICTYP=$G(VAR(1,"IC9",IC,"TYP")) Q:ICTYP'="IC9"
  1.  . S IC9=IC9_$S(IC9]"":";",1:"")_ICCOD
  1.  ;
  1.  ;Abnormal findings prompt
  1.  S ABN=$S($G(VAR(1,"ABN"))]"":VAR(1,"ABN"),1:0)
  1.  ;
  1.  ;Prompt for laterality
  1.  S LAT=$S($G(VAR(1,"LAT"))]"":VAR(1,"LAT"),1:0)
  1.  ;
  1.  ;BSTS*1.0*7;Add laterality and default status
  1.  ;BSTS*2.0;Add healing choices
  1.  S RES=RES_U_ICD_U_IC9_U_ABN_U_LAT_U_$G(VAR(1,"STS"))_U_$G(VAR(1,"HEAL"))_U_$$HLCHC^BSTSMAP1($G(VAR(1,"HEAL")))
  1.  ;
  1.  Q RES
  1.  ;
  1. CONC(IN) ;PEP - Returns basic information for a specified Concept Id
  1.  ;
  1.  ;Input
  1.  ; OUT - Output variable/global to return information in (VAR)
  1.  ;  IN - P1 - The Concept Id to look up
  1.  ;     - P2 (Optional) - The code set Id (default SNOMED '36')
  1.  ;     - P3 (Optional) - Snapshot Date to check (default DT)
  1.  ;     - P4 (Optional) - LOCAL - Pass 1 or blank to perform local listing,
  1.  ;                       Pass 2 for remote DTS listing
  1.  ;     - P5 (Optional) - DEBUG - Pass 1 to display debug information
  1.  ;
  1.  ;Output
  1.  ; Function returns - [1]^[2]^[3]^[4]
  1.  ; [1] - Description Id of Fully Specified Name
  1.  ; [2] - Fully Specified Name
  1.  ; [3] - Description Id of Preferred Term
  1.  ; [4] - Preferred Term
  1.  ; [5] - Mapped ICD Values (based on P3 Snapshot Date)
  1.  ; [6] - Mapped ICD9 Values
  1.  ; [7] - Prompt for Abnormal/Normal Findings (1-Yes,0-No)
  1.  ; [8] - Prompt for Laterality (1-Yes,0-No)
  1.  ; [9] - Default status (Chronic, Personal History, Sub-acute, Admin, Social)
  1.  ; [10] - Prompt for Healing (RDNM, RDN, RD)
  1.  ; [11] - List of healing choices to display (ex. 717128007|NL Union;28087009|Delayed)
  1.  ;
  1.  ;BSTS*1.0*6;Added piece 7 output - prompt for abnormal findings
  1.  NEW VAR,RES,STS,ICD,IC,%D,IC9,ABN,LAT
  1.  S STS=$$CNCLKP^BSTSAPIB("VAR",$G(IN))
  1.  S RES=$G(VAR(1,"FSN","DSC"))_U_$G(VAR(1,"FSN","TRM"))_U_$G(VAR(1,"PRE","DSC"))_U_$G(VAR(1,"PRE","TRM"))
  1.  ;
  1.  ;Tack on Mapped ICD values
  1.  ;
  1.  S ICD="",IC="" F  S IC=$O(VAR(1,"ICD",IC)) Q:IC=""  D
  1.  . NEW ICCOD
  1.  . S ICCOD=$G(VAR(1,"ICD",IC,"COD")) Q:IC=""
  1.  . S ICD=ICD_$S(ICD]"":";",1:"")_ICCOD
  1.  ;
  1.  ;Tack on ICD9 values
  1.  S IC9="",IC="" F  S IC=$O(VAR(1,"IC9",IC)) Q:IC=""  D
  1.  . NEW ICTYP,ICCOD
  1.  . S ICCOD=$G(VAR(1,"IC9",IC,"COD")) Q:IC=""
  1.  . S ICTYP=$G(VAR(1,"IC9",IC,"TYP")) Q:ICTYP'="IC9"
  1.  . S IC9=IC9_$S(IC9]"":";",1:"")_ICCOD
  1.  ;
  1.  ;Abnormal findings prompt
  1.  S ABN=$S($G(VAR(1,"ABN"))]"":VAR(1,"ABN"),1:0)
  1.  ;
  1.  ;Prompt for laterality
  1.  S LAT=$S($G(VAR(1,"LAT"))]"":VAR(1,"LAT"),1:0)
  1.  ;
  1.  ;BSTS*1.0*7;Add laterality and default status
  1.  ;BSTS*2.0;Add healing choices
  1.  S RES=RES_U_ICD_U_IC9_U_ABN_U_LAT_U_$G(VAR(1,"STS"))_U_$G(VAR(1,"HEAL"))_U_$$HLCHC^BSTSMAP1($G(VAR(1,"HEAL")))
  1.  ;
  1.  Q RES
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  Q