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

BSTSAPID.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  Q
  1.  ;
  1. I10ADV(OUT,IN) ;EP - Returns Formatted ICD-10 mapping 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) - LOCAL - Pass 1 or 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]^[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.  ; OUT(#) - Array of formatted information to display for the concept
  1.  ;
  1.  NEW CONCID,LOCAL,DEBUG,STS,MADV,I10ADV,LCNT,II,GRP,PRI,RULE
  1.  ;
  1.  S CONCID=$P(IN,U) I CONCID="" Q "0^Invalid Concept Id"
  1.  S LOCAL=$P(IN,U,2)
  1.  S DEBUG=$P(IN,U,3)
  1.  S LCNT=0
  1.  ;
  1.  K @OUT
  1.  ;
  1.  ;Make call to get the advice
  1.  S STS=$$MPADVICE^BSTSAPI("MADV",CONCID_U_LOCAL_U_U_DEBUG)
  1.  ;
  1.  ;Sort by group and priority
  1.  S II="" F  S II=$O(MADV(II)) Q:II=""  D
  1.  . ;
  1.  . S GRP=+$G(MADV(II,"MPGRP","VAL"))
  1.  . S PRI=+$G(MADV(II,"MPPRI","VAL"))
  1.  . M I10ADV(GRP,PRI,II)=MADV(II)
  1.  ;
  1.  ;Loop through and process
  1.  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
  1.  . ;
  1.  . NEW TGT,TRL,MPA,MPCNT,MPAV,MGRP
  1.  . ;
  1.  . ;BSTS*2.0*1;Added Map Group
  1.  . S MGRP=$G(I10ADV(GRP,PRI,II,"MPGRP","VAL")) S:MGRP="" MGRP="N/A"
  1.  . ;
  1.  . ;Get Target
  1.  . S TGT=$G(I10ADV(GRP,PRI,II,"MPTGT","VAL")) S:TGT="" TGT="N/A"
  1.  . I LCNT>0 S LCNT=LCNT+1,@OUT@(LCNT)=" "
  1.  . S RULE=RULE+1
  1.  . S LCNT=LCNT+1,@OUT@(LCNT)="Rule #"_RULE_$S($L(RULE)=1:"   ",1:"  ")_"Map Group: "_MGRP_"  Target Code: "_TGT
  1.  . ;
  1.  . ;Get Advice
  1.  . S MPA=$G(I10ADV(GRP,PRI,II,"MPADV","VAL"))
  1.  . F MPCNT=1:1:$L(MPA," | ") S MPAV=$P(MPA," | ",MPCNT) I MPAV]"" D
  1.  .. I MPAV="MAP OF SOURCE CONCEPT IS CONTEXT DEPENDENT" Q  ;Filter out unneeded advice
  1.  .. S LCNT=LCNT+1,@OUT@(LCNT)=MPAV
  1.  ;
  1.  ;Check for no advice
  1.  I LCNT=0 S LCNT=1,@OUT@(LCNT)="No mapping advice available"
  1.  ;
  1.  Q STS
  1.  ;
  1. ICD2SMD(OUT,IN) ;EP - Return ICD9 to SNOMED mappings
  1.  ;
  1.  ;Input
  1.  ; OUT - Output variable/global to return information in (VAR)
  1.  ;  IN - P1 - ICD9 Code
  1.  ;     - P2 (Optional) - Return Info (P-Preferred,S-Synonym,B-Subset,I-IsA
  1.  ;                       X-ICD9/ICD10,C-Children) (Default is Subset, ICD, IsA and Children - "BXCI")
  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) - Date to search on (FileMan format - Default to DT)
  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.  ;
  1.  ; The VAR(#) list of records returns the following sections
  1.  ; (based on the input piece 6 and 7 values):
  1.  ;
  1.  ;Concept ID/DTSID
  1.  ; VAR(#,"CON")=Concept Id
  1.  ; VAR(#,"DTS")=Internal DTS Id
  1.  ;
  1.  ;Fully Specified Name
  1.  ; VAR(#,"FSN","DSC")=Description Id of the FSN
  1.  ; VAR(#,"FSN","TRM")=Fully Specified Name
  1.  ; VAR(#,"FSN","XADT")=Date Added
  1.  ; VAR(#,"FSN","XRDT")=Date Retired
  1.  ;
  1.  ;ICD Mapping Information - Multiple Records Returned (CTR)
  1.  ; VAR(#,"ICD",CTR,"COD")=ICD9/ICD10 Code
  1.  ; VAR(#,"ICD",CTR,"TYP")=Code Type(ICD)
  1.  ; VAR(#,"ICD",CTR,"XADT")=Date Added
  1.  ; VAR(#,"ICD",CTR,"XRDT")=Date Retired
  1.  ;
  1.  ;IsA Information - Multiple Records Returned (CTR)
  1.  ; VAR(#,"ISA",CTR,"CON")=Concept Id of IsA Term (may be blank prior to detail lookup)
  1.  ; VAR(#,"ISA",CTR,"DTS")=DTSId of the IsA Term
  1.  ; VAR(#,"ISA",CTR,"TRM")=IsA Term Name
  1.  ; VAR(#,"ISA",CTR,"XADT")=Date Added
  1.  ; VAR(#,"ISA",CTR,"XRDT")=Date Retired
  1.  ;
  1.  ;Child Information - Multiple Records Returned (CTR)
  1.  ; VAR(#,"CHD",CTR,"CON")=Concept Id of Child Term (may be blank prior to detail lookup)
  1.  ; VAR(#,"CHD",CTR,"DTS")=DTSId of the Child Term
  1.  ; VAR(#,"CHD",CTR,"TRM")=IsA Term Name
  1.  ; VAR(#,"CHD",CTR,"XADT")=Date Added
  1.  ; VAR(#,"CHD",CTR,"XRDT")=Date Retired
  1.  ;
  1.  ;Lookup Problem Column Value (Preferred Term Information for concept for Search Type
  1.  ;[F] or Synonym or Preferred Term Information for Search Type [S])
  1.  ;(Based on Search Type parameter - F/S)
  1.  ; VAR(#,"PRB","DSC")=Description Id of a Pref Term (Type F) or Synonym/Pref Term (S)
  1.  ; VAR(#,"PRB","TRM")=Preferred Name of a Concept (F) or a Synonym/Preferred Name (S)
  1.  ;
  1.  ;Preferred Term Information
  1.  ; VAR(#,"PRE","DSC")=Description ID of Preferred Term
  1.  ; VAR(#,"PRE","TRM")=Preferred Term
  1.  ; VAR(#,"PRE","XADT")=Date Added
  1.  ; VAR(#,"PRE","XRDT")=Date Retired
  1.  ;
  1.  ;Subset Information - Multiple Records Returned (CTR)
  1.  ; VAR(#,"SUB",CTR,"SUB")=Subset Name
  1.  ; VAR(#,"SUB",CTR,"XADT")=Date Added
  1.  ; VAR(#,"SUB",CTR,"XRDT")=Date Retired
  1.  ;
  1.  ;Synonym Information - Multiple Records Returned (CTR)
  1.  ; VAR(#,"SYN",CTR,"DSC")=Description ID of Synonym
  1.  ; VAR(#,"SYN",CTR,"TRM")=Synonym Term
  1.  ; VAR(#,"SYN",CTR,"XADT")=Date Added
  1.  ; VAR(#,"SYN",CTR,"XRDT")=Date Retired
  1.  ;
  1.  ;Date Concept Added/Retired
  1.  ; VAR(#,"XADT")=Date Added
  1.  ; VAR(#,"XRDT")=Date Retired
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSAPIC D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  N SEARCH,STYPE,NMID,SUB,SNAPDT,MAX,BCTCHRC,BCTCHCT,LOCAL,%D
  1.  N RESULT,DEBUG,BSTSR,BSTSI,RET,DAT,BSTSWS,BSTSD,X,%,%H,INDATE
  1.  K @OUT
  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 NMID=36
  1.  S SNAPDT=$P(IN,U,5) S:SNAPDT="" SNAPDT=DT
  1.  S SNAPDT=SNAPDT_".2400"
  1.  S INDATE=$P(SNAPDT,".")
  1.  S SNAPDT=$$FMDT2XML^BSTSUTIL(SNAPDT)
  1.  S MAX=10000
  1.  S RET=$P(IN,U,2) S:RET="" RET="BXCI"
  1.  S DAT=1
  1.  S BCTCHRC=""
  1.  S BCTCHCT=""
  1.  S LOCAL=$P(IN,U,3),LOCAL=$S(LOCAL=2:"",1:"1")
  1.  S DEBUG=$P(IN,U,4),DEBUG=$S(DEBUG=1:"1",1:"")
  1.  ;
  1.  S BSTSWS("SEARCH")=SEARCH
  1.  S BSTSWS("NAMESPACEID")=NMID
  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.  ;
  1.  S BSTSI=0
  1.  ;
  1.  ;Make DTS search call
  1.  S BSTSR=1
  1.  ;
  1.  ;DTS Call
  1.  I LOCAL'=1 S BSTSR=$$ICD2SMD^BSTSWSV("RESULT",.BSTSWS,DEBUG) S:+BSTSR $P(BSTSR,U)=2
  1.  ;
  1.  ;If no results, try performing local search
  1.  I $D(RESULT)<10 S BSTSD=$$ICD2SMD^BSTSAPIF("RESULT",BSTSWS("SEARCH")) S:+BSTSD $P(BSTSR,U)=+BSTSD
  1.  ;
  1.  ;If no results and local, try performing DTS search
  1.  I $D(RESULT)<10,LOCAL S BSTSR=$$ICD2SMD^BSTSWSV("RESULT",.BSTSWS,DEBUG) S:+BSTSR $P(BSTSR,U)=2
  1.  ;
  1.  ;Loop through search results and retrieve detail
  1.  S BSTSWS("STYPE")="F"
  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. CVRSN(OUT,IN) ;EP - Return the Current Version For the Code Set
  1.  ;
  1.  ;Input
  1.  ; OUT - Output variable/global to return information in (VAR)
  1.  ;  IN - P1 (Optional) - The code set Id (default SNOMED US EXT '36')
  1.  ;  IN - 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.  ; Single VAR record is returned
  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.  N LOCAL,DEBUG,BSTSR,NMID,NMIEN,BSTSI,VRID,X,%,%H,%D
  1.  K @OUT
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSAPID D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  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 result
  1.  S NMIEN=$O(^BSTS(9002318.1,"B",NMID,""))
  1.  I NMIEN]"" S VRID=$O(^BSTS(9002318.1,NMIEN,1,"B",""),-1) I VRID]"" D
  1.  . N VRIEN
  1.  . S VRIEN=$O(^BSTS(9002318.1,NMIEN,1,"B",VRID,""),-1) I 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 @OUT=VRID_U_VRNAME_U_VRRLDT_U_VRINDT
  1.  S $P(BSTSR,U)=$S(@OUT="":0,(+BSTSR)>0:+BSTSR,1:1)
  1.  Q BSTSR
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  Q