BQILKSMD ;GDIT/HS/BEE - SNOMED Utilities ; 10 Aug 2012 9:24 AM
;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
;
Q
;
SEARCH(DATA,SEARCH) ;EP - BQI SNOMED SEARCH
;
;Description
; Returns a list of SNOMED CT Terms matching the specified search string
;
;Input
; SEARCH - The string to search on
;
;Output
; ^TMP("BQILKSMD") - Name of global (passed by reference) in which the data is stored.
;
;Variables Used
; UID - Unique TMP global subscript.
;
N UID,BQII,SVAR,STS,II
;
S SEARCH=$TR(SEARCH,"|","^")
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQILKSMD",UID))
S SVAR=$NA(^TMP("BQILKSER",UID))
K @DATA,@SVAR
;
S BQII=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQILKSMD D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
D HDR
;
;Validate input
I $G(SEARCH)="" G DONE
;
;Perform lookup
S STS=$$SEARCH^BSTSAPI(SVAR,SEARCH)
;
;Output Results
S II=0 F S II=$O(@SVAR@(II)) Q:II="" D
. NEW PRBD,PRBT,CONC,DTS,FSND,FSNT,PRED,PRET
. NEW ISA,ICD9,SUB,SYN,MICD,D10,ISHDR
. ;
. ;Problem Description and Term
. S PRBD=$G(@SVAR@(II,"PRB","DSC"))
. S PRBT=$G(@SVAR@(II,"PRB","TRM"))
. W !,II,?10,"PRBD: ",PRBD,"|",PRBT
. S CONC=$G(@SVAR@(II,"CON"))
. S DTS=$G(@SVAR@(II,"DTS"))
. S FSND=$G(@SVAR@(II,"FSN","DSC"))
. S FSNT=$G(@SVAR@(II,"FSN","TRM"))
. S PRED=$G(@SVAR@(II,"PRE","DSC"))
. S PRET=$G(@SVAR@(II,"PRE","TRM"))
. S ISHDR=$S(PRED=PRBD:"",1:"S")
. ;
. ;ISA
. S ISA="" I $D(@SVAR@(II,"ISA")) D
.. NEW ICNT
.. S ICNT="" F S ICNT=$O(@SVAR@(II,"ISA",ICNT)) Q:ICNT="" D
... NEW DTS,CON,TRM
... S DTS=$G(@SVAR@(II,"ISA",ICNT,"DTS"))
... S CON=$G(@SVAR@(II,"ISA",ICNT,"CON"))
... S TRM=$G(@SVAR@(II,"ISA",ICNT,"TRM"))
... S ISA=ISA_$S(ISA]"":$C(28),1:"")_DTS_$C(29)_CON_$C(29)_TRM
. ;
. ;ICD9
. S ICD9="" I $D(@SVAR@(II,"ICD")) D
.. NEW ICNT
.. S ICNT="" F S ICNT=$O(@SVAR@(II,"ICD",ICNT)) Q:ICNT="" D
... NEW ICD
... S ICD=$G(@SVAR@(II,"ICD",ICNT,"COD"))
... S ICD9=ICD9_$S(ICD9]"":$C(28),1:"")_ICD
. ;
. ;ICD10
. S D10=""
. ;
. ;Subsets
. S SUB="" I $D(@SVAR@(II,"SUB")) D
.. NEW ICNT
.. S ICNT="" F S ICNT=$O(@SVAR@(II,"SUB",ICNT)) Q:ICNT="" D
... NEW SB
... S SB=$G(@SVAR@(II,"SUB",ICNT,"SUB"))
... S SUB=SUB_$S(SUB]"":$C(28),1:"")_SB
. ;
. ;Synonyms
. S SYN=PRED_$C(29)_PRET_$C(29)_"Preferred" I $D(@SVAR@(II,"SYN")) D
.. NEW ICNT
.. S ICNT="" F S ICNT=$O(@SVAR@(II,"SYN",ICNT)) Q:ICNT="" D
... NEW TRM,DSC
... S TRM=$G(@SVAR@(II,"SYN",ICNT,"TRM"))
... S DSC=$G(@SVAR@(II,"SYN",ICNT,"DSC"))
... S SYN=SYN_$S(SYN]"":$C(28),1:"")_DSC_$C(29)_TRM_$C(29)_"Synonym"
. ;
. S MICD=ICD9
. ;Save entry
. S BQII=BQII+1,@DATA@(BQII)=PRBD_U_PRBT_U_CONC_U_DTS_U_FSND_U_FSNT_U_ISA
. S @DATA@(BQII)=@DATA@(BQII)_U_ICD9_U_SUB_U_D10_U_SYN_U_ISHDR_U_MICD_$C(30)
;
DONE ;
S BQII=BQII+1,@DATA@(BQII)=$C(31)
Q
;
HDR ;
NEW HDR
S HDR="T00050PRB_DSC^T00250PRB_TRM^T00050CONCID^T00030DTSID^T00050FSN_DSC^T00250FSN_TRM"
S HDR=HDR_"^T04096ISA^T04096ICD9^T04096SUBSETS^T0409610D^T04096SYNONYMS"
S HDR=HDR_"^T00001ISA_SYN_HDR^T04096MAPPED_ICD"
S @DATA@(BQII)=HDR_$C(30)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)
Q
BQILKSMD ;GDIT/HS/BEE - SNOMED Utilities ; 10 Aug 2012 9:24 AM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
+2 ;
+3 QUIT
+4 ;
SEARCH(DATA,SEARCH) ;EP - BQI SNOMED SEARCH
+1 ;
+2 ;Description
+3 ; Returns a list of SNOMED CT Terms matching the specified search string
+4 ;
+5 ;Input
+6 ; SEARCH - The string to search on
+7 ;
+8 ;Output
+9 ; ^TMP("BQILKSMD") - Name of global (passed by reference) in which the data is stored.
+10 ;
+11 ;Variables Used
+12 ; UID - Unique TMP global subscript.
+13 ;
+14 NEW UID,BQII,SVAR,STS,II
+15 ;
+16 SET SEARCH=$TRANSLATE(SEARCH,"|","^")
+17 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+18 SET DATA=$NAME(^TMP("BQILKSMD",UID))
+19 SET SVAR=$NAME(^TMP("BQILKSER",UID))
+20 KILL @DATA,@SVAR
+21 ;
+22 SET BQII=0
+23 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQILKSMD D UNWIND^%ZTER"
+24 ;
+25 DO HDR
+26 ;
+27 ;Validate input
+28 IF $GET(SEARCH)=""
GOTO DONE
+29 ;
+30 ;Perform lookup
+31 SET STS=$$SEARCH^BSTSAPI(SVAR,SEARCH)
+32 ;
+33 ;Output Results
+34 SET II=0
FOR
SET II=$ORDER(@SVAR@(II))
IF II=""
QUIT
Begin DoDot:1
+35 NEW PRBD,PRBT,CONC,DTS,FSND,FSNT,PRED,PRET
+36 NEW ISA,ICD9,SUB,SYN,MICD,D10,ISHDR
+37 ;
+38 ;Problem Description and Term
+39 SET PRBD=$GET(@SVAR@(II,"PRB","DSC"))
+40 SET PRBT=$GET(@SVAR@(II,"PRB","TRM"))
+41 WRITE !,II,?10,"PRBD: ",PRBD,"|",PRBT
+42 SET CONC=$GET(@SVAR@(II,"CON"))
+43 SET DTS=$GET(@SVAR@(II,"DTS"))
+44 SET FSND=$GET(@SVAR@(II,"FSN","DSC"))
+45 SET FSNT=$GET(@SVAR@(II,"FSN","TRM"))
+46 SET PRED=$GET(@SVAR@(II,"PRE","DSC"))
+47 SET PRET=$GET(@SVAR@(II,"PRE","TRM"))
+48 SET ISHDR=$SELECT(PRED=PRBD:"",1:"S")
+49 ;
+50 ;ISA
+51 SET ISA=""
IF $DATA(@SVAR@(II,"ISA"))
Begin DoDot:2
+52 NEW ICNT
+53 SET ICNT=""
FOR
SET ICNT=$ORDER(@SVAR@(II,"ISA",ICNT))
IF ICNT=""
QUIT
Begin DoDot:3
+54 NEW DTS,CON,TRM
+55 SET DTS=$GET(@SVAR@(II,"ISA",ICNT,"DTS"))
+56 SET CON=$GET(@SVAR@(II,"ISA",ICNT,"CON"))
+57 SET TRM=$GET(@SVAR@(II,"ISA",ICNT,"TRM"))
+58 SET ISA=ISA_$SELECT(ISA]"":$CHAR(28),1:"")_DTS_$CHAR(29)_CON_$CHAR(29)_TRM
End DoDot:3
End DoDot:2
+59 ;
+60 ;ICD9
+61 SET ICD9=""
IF $DATA(@SVAR@(II,"ICD"))
Begin DoDot:2
+62 NEW ICNT
+63 SET ICNT=""
FOR
SET ICNT=$ORDER(@SVAR@(II,"ICD",ICNT))
IF ICNT=""
QUIT
Begin DoDot:3
+64 NEW ICD
+65 SET ICD=$GET(@SVAR@(II,"ICD",ICNT,"COD"))
+66 SET ICD9=ICD9_$SELECT(ICD9]"":$CHAR(28),1:"")_ICD
End DoDot:3
End DoDot:2
+67 ;
+68 ;ICD10
+69 SET D10=""
+70 ;
+71 ;Subsets
+72 SET SUB=""
IF $DATA(@SVAR@(II,"SUB"))
Begin DoDot:2
+73 NEW ICNT
+74 SET ICNT=""
FOR
SET ICNT=$ORDER(@SVAR@(II,"SUB",ICNT))
IF ICNT=""
QUIT
Begin DoDot:3
+75 NEW SB
+76 SET SB=$GET(@SVAR@(II,"SUB",ICNT,"SUB"))
+77 SET SUB=SUB_$SELECT(SUB]"":$CHAR(28),1:"")_SB
End DoDot:3
End DoDot:2
+78 ;
+79 ;Synonyms
+80 SET SYN=PRED_$CHAR(29)_PRET_$CHAR(29)_"Preferred"
IF $DATA(@SVAR@(II,"SYN"))
Begin DoDot:2
+81 NEW ICNT
+82 SET ICNT=""
FOR
SET ICNT=$ORDER(@SVAR@(II,"SYN",ICNT))
IF ICNT=""
QUIT
Begin DoDot:3
+83 NEW TRM,DSC
+84 SET TRM=$GET(@SVAR@(II,"SYN",ICNT,"TRM"))
+85 SET DSC=$GET(@SVAR@(II,"SYN",ICNT,"DSC"))
+86 SET SYN=SYN_$SELECT(SYN]"":$CHAR(28),1:"")_DSC_$CHAR(29)_TRM_$CHAR(29)_"Synonym"
End DoDot:3
End DoDot:2
+87 ;
+88 SET MICD=ICD9
+89 ;Save entry
+90 SET BQII=BQII+1
SET @DATA@(BQII)=PRBD_U_PRBT_U_CONC_U_DTS_U_FSND_U_FSNT_U_ISA
+91 SET @DATA@(BQII)=@DATA@(BQII)_U_ICD9_U_SUB_U_D10_U_SYN_U_ISHDR_U_MICD_$CHAR(30)
End DoDot:1
+92 ;
DONE ;
+1 SET BQII=BQII+1
SET @DATA@(BQII)=$CHAR(31)
+2 QUIT
+3 ;
HDR ;
+1 NEW HDR
+2 SET HDR="T00050PRB_DSC^T00250PRB_TRM^T00050CONCID^T00030DTSID^T00050FSN_DSC^T00250FSN_TRM"
+3 SET HDR=HDR_"^T04096ISA^T04096ICD9^T04096SUBSETS^T0409610D^T04096SYNONYMS"
+4 SET HDR=HDR_"^T00001ISA_SYN_HDR^T04096MAPPED_ICD"
+5 SET @DATA@(BQII)=HDR_$CHAR(30)
+6 QUIT
+7 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(BQII)
IF $DATA(DATA)
SET BQII=BQII+1
SET @DATA@(BQII)=$CHAR(31)
+6 QUIT
