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

BSTSRPCU.m

Go to the documentation of this file. 
  1. BSTSRPCU ;GDIT/HS/BEE - SNOMED Utilities - RPC Universe Search ; 10 Aug 2012  9:24 AM
  1.  ;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62
  1.  ;
  1.  Q
  1.  ;
  1. USEARCH(DATA,SEARCH) ;EP - BSTS SNOMED UNIVERSE SEARCH
  1.  ;
  1.  ;Description
  1.  ;  Perform a Codeset Universe Lookup
  1.  ;  Returns a set of terms matching the specified search string
  1.  ;  
  1.  ;Input
  1.  ;  SEARCH - The string to search on
  1.  ;
  1.  ;Output
  1.  ;  ^TMP("BSTSRPCU") - Name of global (passed by reference) in which the data is stored.
  1.  ;
  1.  ;Variables Used
  1.  ;  UID - Unique TMP global subscript.
  1.  ;
  1.  N UID,BSTSII,SVAR,STS,II,%D
  1.  ;
  1.  S SEARCH=$TR(SEARCH,"|","^")
  1.  S $P(SEARCH,U,5)=""
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BSTSRPCU",UID))
  1.  S SVAR=$NA(^TMP("BSTSRPC1",UID))
  1.  K @DATA,@SVAR
  1.  ;
  1.  S BSTSII=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSRPCU D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  D UHDR
  1.  ;
  1.  ;Validate input
  1.  I $G(SEARCH)="" G UDONE
  1.  ;
  1.  ;Perform lookup
  1.  S STS=$$USEARCH^BSTSAPIF(SVAR,SEARCH)
  1.  ;
  1.  ;Output Results
  1.  S II=0 F  S II=$O(@SVAR@(II)) Q:II=""  D
  1.  . NEW PRBD,PRBT,CONC,DTS,FSND,FSNT,ISA,SYN,PS,SUB
  1.  . NEW ASSC,MAPP
  1.  . ;
  1.  . ;Problem Description and Term
  1.  . S PRBD=$P($G(@SVAR@(II)),U,3)
  1.  . S PRBT=$P($G(@SVAR@(II)),U,2)
  1.  . S CONC=$P($G(@SVAR@(II)),U)
  1.  . S DTS=$P($G(@SVAR@(II)),U,8)
  1.  . S FSND=$P($G(@SVAR@(II)),U,5)
  1.  . S FSNT=$P($G(@SVAR@(II)),U,4)
  1.  . ;
  1.  . ;ISA
  1.  . S ISA=$P($G(@SVAR@(II)),U,7)
  1.  . ;
  1.  . ;Synonym
  1.  . S SYN=$P($G(@SVAR@(II)),U,6)
  1.  . ;
  1.  . ;Preferred/Synonym
  1.  . S PS=$P($G(@SVAR@(II)),U,10)
  1.  . ;
  1.  . ;Subsets
  1.  . S SUB=$P($G(@SVAR@(II)),U,9) D
  1.  . ;
  1.  . ;Associations
  1.  . S ASSC=$P($G(@SVAR@(II)),U,11)
  1.  . ;
  1.  . ;Mappings
  1.  . S MAPP=$P($G(@SVAR@(II)),U,12)
  1.  . ;
  1.  . ;Save entry
  1.  . S BSTSII=BSTSII+1,@DATA@(BSTSII)=PRBT_U_PRBD_U_PS_U_FSNT_U_CONC_U_FSND_U_SYN_U_ISA_U_DTS_U_SUB_U_ASSC_U_MAPP
  1.  . S @DATA@(BSTSII)=@DATA@(BSTSII)_$C(30)
  1.  ;
  1.  ;Reset Scratch Global
  1.  K @SVAR
  1.  ;
  1. UDONE ;
  1.  S BSTSII=BSTSII+1,@DATA@(BSTSII)=$C(31)
  1.  Q
  1.  ;
  1. UHDR ;
  1.  NEW HDR
  1.  S HDR="T00250PRB_TRM^T00050PRB_DSC^T00001PS^T00250FSN_TERM^T00250CONCID^T00050FSN_DSC"
  1.  S HDR=HDR_"^T04096SYNONYMS^T04096RELATION^T00050HIDDEN_DTSID^T04096SUBSETS^T04096ASSOCIATION^T04096MAPPING"
  1.  S @DATA@(BSTSII)=HDR_$C(30)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(BSTSII),$D(DATA) S BSTSII=BSTSII+1,@DATA@(BSTSII)=$C(31)
  1.  Q