[628] | 1 | LEXTRAN ; ISL/FJF - Lexicon code and text wrapper API's ; 01/31/2006
|
---|
| 2 | ;;2.0;LEXICON UTILITY;**41**;Sep 23, 1996;Build 34
|
---|
| 3 | ; Per VHA Directive 2004-038, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | CODE(LEXCODE,LEXSRC,LEXVDT,LEXRAY) ;
|
---|
| 6 | ; Lexicon wrapper application to obtain concept data for a given code
|
---|
| 7 | ; and source
|
---|
| 8 | ;
|
---|
| 9 | ; Input
|
---|
| 10 | ;
|
---|
| 11 | ; LEXCODE code - mandatory
|
---|
| 12 | ; LEXSRC code system source abbreviation e.g. SCT (SNOMED CT)
|
---|
| 13 | ; - mandatory
|
---|
| 14 | ; LEXVDT effective date (defaults to current date) - optional
|
---|
| 15 | ; LEXRAY output array (defaults to 'LEX') optionaL
|
---|
| 16 | ;
|
---|
| 17 | ; Output
|
---|
| 18 | ;
|
---|
| 19 | ; if call finds an active code for the source
|
---|
| 20 | ; "1^LEXCODE"
|
---|
| 21 | ; LEX - an array containing information about the code
|
---|
| 22 | ; LEX(0) - a five piece string:
|
---|
| 23 | ; 1. code
|
---|
| 24 | ; 2. hierarchy
|
---|
| 25 | ; 3. version
|
---|
| 26 | ; 4. legacy code
|
---|
| 27 | ; 5. code status
|
---|
| 28 | ; LEX("F") fully specified name
|
---|
| 29 | ; LEX("P") preferred term
|
---|
| 30 | ; LEX("S",n) synonyms (n is the nth synonym)
|
---|
| 31 | ;
|
---|
| 32 | ; if call cannot find specified code on file
|
---|
| 33 | ; "-2^"_LEXSCNM_" code "_LEXCODE_" not on file"
|
---|
| 34 | ; where LEXSCNM is the source name
|
---|
| 35 | ; LEXCODE is the code
|
---|
| 36 | ;
|
---|
| 37 | ; if call finds an inactive code for the source
|
---|
| 38 | ; "-4^"_LEXSCNM_" code "_LEXCODE_" not active for "_LEXVDT
|
---|
| 39 | ; LEX - an array containing information about the code
|
---|
| 40 | ; LEX(0) - a five piece string:
|
---|
| 41 | ; 1. code
|
---|
| 42 | ; 2. hierarchy
|
---|
| 43 | ; 3. version
|
---|
| 44 | ; 4. legacy code
|
---|
| 45 | ; 5. code status
|
---|
| 46 | ;
|
---|
| 47 | ; otherwise
|
---|
| 48 | ; "-1^error text"
|
---|
| 49 | ;
|
---|
| 50 | ; example of LEX array:
|
---|
| 51 | ; LEX(0)="67922002^Substance^20050701^T-C2500^1"
|
---|
| 52 | ; LEX("F")="Serum (Substance)"
|
---|
| 53 | ; LEX("P")="Serum"
|
---|
| 54 | ;
|
---|
| 55 | ; check passed parameter arguments
|
---|
| 56 | ;
|
---|
| 57 | I $G(LEXCODE)="" Q "-1^no code specified"
|
---|
| 58 | I $G(LEXSRC)="" Q "-1^no source specified"
|
---|
| 59 | I '$D(^LEX(757.03,"B",LEXSRC)) Q "-1^source not recognized"
|
---|
| 60 | I $D(^TMP("LEXSCH",$J,"VDT",0)) S LEXVDT=^(0)
|
---|
| 61 | I $G(LEXVDT)'="" S LEXVDT=$$INTDAT(LEXVDT)
|
---|
| 62 | I $G(LEXVDT)=-1 Q "-1^invalid date format"
|
---|
| 63 | I $G(LEXVDT)="" S LEXVDT=$$DT^XLFDT
|
---|
| 64 | I $G(LEXRAY)="" K LEXRAY
|
---|
| 65 | ;
|
---|
| 66 | ; obtain source mnemonic and ASAB
|
---|
| 67 | ;
|
---|
| 68 | N LEXSCNM,LEXSIEN,LEXASAB,LEXCIEN,VALCODE,LEXSTAT,LEXPIEN,T
|
---|
| 69 | ;
|
---|
| 70 | S LEXSIEN=$O(^LEX(757.03,"B",LEXSRC,""))
|
---|
| 71 | S T=^LEX(757.03,LEXSIEN,0)
|
---|
| 72 | S LEXSCNM=$P(T,U,2)
|
---|
| 73 | S LEXASAB=$E($P(T,U),1,3)
|
---|
| 74 | ;
|
---|
| 75 | ; check for code existence for source
|
---|
| 76 | ;
|
---|
| 77 | S LEXCIEN="",VALCODE=0
|
---|
| 78 | F Q:VALCODE=1 D Q:LEXCIEN=""
|
---|
| 79 | .S LEXCIEN=$O(^LEX(757.02,"CODE",LEXCODE_" ",LEXCIEN)) Q:LEXCIEN="" D
|
---|
| 80 | .I $D(^LEX(757.02,"ASRC",LEXASAB,LEXCIEN)) S VALCODE=1 Q
|
---|
| 81 | I 'VALCODE Q "-2^"_LEXSCNM_" code "_LEXCODE_" not on file"
|
---|
| 82 | ;
|
---|
| 83 | ; now we know that the code belongs to the source and that it is known
|
---|
| 84 | ; in our files
|
---|
| 85 | ; check that code is valid for date
|
---|
| 86 | ;
|
---|
| 87 | K LEXSTAT,LEX
|
---|
| 88 | K ^TMP("LEXSCH",$J)
|
---|
| 89 | S LEXSTAT=$$STATCHK^LEXSRC2(LEXCODE,LEXVDT,.LEXSTAT)
|
---|
| 90 | I +LEXSTAT=0 D Q "-4^"_LEXSCNM_" code "_LEXCODE_" not active for "_LEXVDT
|
---|
| 91 | .S LEXPIEN=$P(LEXSTAT(1),U)
|
---|
| 92 | .D INFO^LEXA(LEXPIEN)
|
---|
| 93 | .D GETINFO
|
---|
| 94 | .I $D(LEXRAY),LEXRAY'="LEX" M @LEXRAY=LEX K LEX
|
---|
| 95 | ;
|
---|
| 96 | ; if we've got this far we have a good code that is active
|
---|
| 97 | S LEXPIEN=$P(LEXSTAT(1),U)
|
---|
| 98 | ;Q "1^"_LEXCODE
|
---|
| 99 | D INFO^LEXA(LEXPIEN)
|
---|
| 100 | D GETINFO
|
---|
| 101 | I $D(LEXRAY),LEXRAY'="LEX" M @LEXRAY=LEX K LEX
|
---|
| 102 | ;
|
---|
| 103 | Q "1^"_LEXCODE
|
---|
| 104 | ;
|
---|
| 105 | GETINFO ; obtain information for code and populate LEX array
|
---|
| 106 | ;
|
---|
| 107 | N LEXFSN,LEXHIER,LEXLGY,LEXVER,N,LEXSEP,I
|
---|
| 108 | I $D(LEX("SEL","EXP","C","FUL")) D
|
---|
| 109 | .S LEXFSN=LEX("SEL","EXP",$O(LEX("SEL","EXP","C","FUL","")))
|
---|
| 110 | .S LEXHIER=$P($P(LEXFSN,"(",$L(LEXFSN,"(")),")")
|
---|
| 111 | ; legacy code
|
---|
| 112 | S LEXLGY=$$GET1^DIQ(757.02,LEXCIEN_",",13)
|
---|
| 113 | ; version
|
---|
| 114 | S LEXVER=$$VERSION(LEXSRC,LEXCODE,LEXVDT)
|
---|
| 115 | ; create return array
|
---|
| 116 | ;S LEXSEP=" ["_LEXCODE_"]"
|
---|
| 117 | S LEX(0)=LEXCODE_U_$G(LEXHIER)_U_$S(+LEXVER=-1:"",1:$P(LEXVER,U,3))
|
---|
| 118 | S LEX(0)=LEX(0)_U_LEXLGY_U_+LEXSTAT
|
---|
| 119 | S LEX("P")=$P(LEX("SEL","EXP",$O(LEX("SEL","EXP","C","MAJ",""))),U,2)
|
---|
| 120 | I $D(LEXFSN) S LEX("F")=$P(LEXFSN,"^",2)
|
---|
| 121 | S N=""
|
---|
| 122 | F I=1:1 S N=$O(LEX("SEL","EXP","C","SYN",N)) Q:N="" D
|
---|
| 123 | .S LEX("S",I)=$P(LEX("SEL","EXP",N),U,2)
|
---|
| 124 | K LEX("SEL")
|
---|
| 125 | Q
|
---|
| 126 | ;
|
---|
| 127 | TEXT(LEXTEXT,LEXVDT,LEXSUB,LEXSRC,LEXRAY) ;
|
---|
| 128 | ;
|
---|
| 129 | ; Lexicon wrapper application to obtain concept data for a given text
|
---|
| 130 | ; and source
|
---|
| 131 | ;
|
---|
| 132 | ; Input
|
---|
| 133 | ;
|
---|
| 134 | ; LEXTEXT the search string - mandatory
|
---|
| 135 | ; LEXVDT effective date (defaults to current date) - optional
|
---|
| 136 | ; LEXSUB subset or 'hierarchy' - optional
|
---|
| 137 | ; LEXSRC code system source abbreviation e.g. SCT (SNOMED CT)
|
---|
| 138 | ; - optional
|
---|
| 139 | ; LEXRAY output array (defaults to 'LEX')- optional
|
---|
| 140 | ;
|
---|
| 141 | ; Output
|
---|
| 142 | ;
|
---|
| 143 | ; LEX or passed array name - an array containing information
|
---|
| 144 | ; about the code
|
---|
| 145 | ; LEX(0) - a five piece string:
|
---|
| 146 | ; 1. code
|
---|
| 147 | ; 2. hierarchy
|
---|
| 148 | ; 3. version
|
---|
| 149 | ; 4. legacy code
|
---|
| 150 | ; 5. code status
|
---|
| 151 | ;
|
---|
| 152 | ; otherwise
|
---|
| 153 | ; "-1^error text"
|
---|
| 154 | ;
|
---|
| 155 | ; example of LEX array:
|
---|
| 156 | ; LEX(0)="67922002^Substance^20050701^T-C2500^1"
|
---|
| 157 | ; LEX("F")="Serum (Substance)"
|
---|
| 158 | ; LEX("P")="Serum"
|
---|
| 159 | ;
|
---|
| 160 | I $G(LEXTEXT)="" Q "-1^no search string specified"
|
---|
| 161 | S LEXSRC=$G(LEXSRC)
|
---|
| 162 | I $G(LEXVDT)'="" S LEXVDT=$$INTDAT(LEXVDT)
|
---|
| 163 | I $G(LEXVDT)=-1 Q "-1^invalid date format"
|
---|
| 164 | I $G(LEXVDT)="" S LEXVDT=$$DT^XLFDT
|
---|
| 165 | S LEXSRC=$G(LEXSRC)
|
---|
| 166 | S LEXSUB=$G(LEXSUB) I LEXSUB="" S LEXSUB=LEXSRC
|
---|
| 167 | I $G(LEXRAY)="" K LEXRAY
|
---|
| 168 | ;
|
---|
| 169 | N X,LEXPIEN,LEXCODE,LEXSTAT,LEXCIEN,Y
|
---|
| 170 | K ^TMP("LEXSCH",$J),LEX
|
---|
| 171 | S X=LEXTEXT
|
---|
| 172 | D CONFIG^LEXSET(LEXSRC,LEXSUB,LEXVDT)
|
---|
| 173 | D EN^LEXA1
|
---|
| 174 | I +Y=-1 Q "-1^search could not find term"
|
---|
| 175 | ;
|
---|
| 176 | S LEXPIEN=+Y
|
---|
| 177 | D INFO^LEXA(LEXPIEN)
|
---|
| 178 | S LEXCODE=$O(LEX("SEL","SRC","C",""))
|
---|
| 179 | S LEXSTAT=$$STATCHK^LEXSRC2(LEXCODE,LEXVDT,.LEXSTAT)
|
---|
| 180 | S LEXCIEN=$P(LEXSTAT,U,2)
|
---|
| 181 | S LEXSRC=$P(LEXSTAT(2),U,2)
|
---|
| 182 | D GETINFO
|
---|
| 183 | I $D(LEXRAY),LEXRAY'="LEX" M @LEXRAY=LEX K LEX
|
---|
| 184 | Q "1^"_LEXPIEN
|
---|
| 185 | ;
|
---|
| 186 | VERSION(LEXSRC,LEXCODE,LEXVDT) ;
|
---|
| 187 | ; infer version of code
|
---|
| 188 | ; Input
|
---|
| 189 | ;
|
---|
| 190 | ; LEXSRC code system source abbreviation e.g. SCT (SNOMED CT)
|
---|
| 191 | ; LEXCODE code - mandatory
|
---|
| 192 | ; LEXVDT effective date (defaults to current date) - optional
|
---|
| 193 | ; - optional
|
---|
| 194 | ;
|
---|
| 195 | ; Output
|
---|
| 196 | ;
|
---|
| 197 | ; 1^Version
|
---|
| 198 | ; or
|
---|
| 199 | ; -1^error message
|
---|
| 200 | ;
|
---|
| 201 | I $G(LEXVDT)'="" S LEXVDT=$$INTDAT(LEXVDT)
|
---|
| 202 | I $G(LEXVDT)=-1 Q "-1^invalid date format"
|
---|
| 203 | I $G(LEXVDT)="" S LEXVDT=$$DT^XLFDT
|
---|
| 204 | N SIEN,VIEN,VDAT,LEXSTAT
|
---|
| 205 | S SIEN=$O(^LEX(757.03,"B",LEXSRC,""))
|
---|
| 206 | I '$D(^LEX(757.03,SIEN,1)) Q "-1^No source version data available"
|
---|
| 207 | S LEXSTAT=$$STATCHK^LEXSRC2(LEXCODE,LEXVDT,.LEXSTAT)
|
---|
| 208 | I +LEXSTAT=0 Q "-1^Code not active for date specified"
|
---|
| 209 | S VDAT=$O(^LEX(757.03,SIEN,1,"B",LEXVDT+1),-1)
|
---|
| 210 | S VIEN=$O(^LEX(757.03,SIEN,1,"B",VDAT,""))
|
---|
| 211 | Q "1^"_^LEX(757.03,SIEN,1,VIEN,0)
|
---|
| 212 | ;
|
---|
| 213 | ;
|
---|
| 214 | TXT4CS(LEXTEXT,LEXSRC,LEXRAY,LEXSUB) ; Is text valid for an SCT code
|
---|
| 215 | ;
|
---|
| 216 | ; Input
|
---|
| 217 | ;
|
---|
| 218 | ; LEXTEXT is term being checked
|
---|
| 219 | ; LEXSRC is code system mnemonic or IEN
|
---|
| 220 | ; LEXRAY output array (defaults to 'LEX') optional
|
---|
| 221 | ; LEXSUB subset or 'hierarchy' - optional
|
---|
| 222 | ;
|
---|
| 223 | ; Output
|
---|
| 224 | ;
|
---|
| 225 | ; 1^no of finds
|
---|
| 226 | ; plus
|
---|
| 227 | ; LEX or passed array name - an array containing discovered
|
---|
| 228 | ; concept IDs and expression type
|
---|
| 229 | ; for finds
|
---|
| 230 | ; e.g. LEX(113912006)="MAJOR CONCEPT"
|
---|
| 231 | ;
|
---|
| 232 | ; or
|
---|
| 233 | ;
|
---|
| 234 | ; -1^error message
|
---|
| 235 | ;
|
---|
| 236 | N EXP,EXIEN,MCIEN,FOUND,CIEN,CODE,EXPTYP,FINDS,LAR,HIER,HIERNAM,LEXW
|
---|
| 237 | I $G(LEXTEXT)="" Q "-1^text not specified"
|
---|
| 238 | I $G(LEXSRC)="" Q "-1^code system not specified"
|
---|
| 239 | I $$CSYSIEN(LEXSRC)+$$CSYSMNEM(LEXSRC)=-2 Q "-1^code system unknown in Lexicon"
|
---|
| 240 | I $G(LEXRAY)="" K LEXRAY
|
---|
| 241 | S LEXSUB=$G(LEXSUB)
|
---|
| 242 | I LEXSUB'="",'$D(^LEXT(757.2,"AA",LEXSUB)) Q "-1^hierarchy unknown in Lexicon"
|
---|
| 243 | S:LEXSRC?.N LEXSRC=$P($$CSYSMNEM(LEXSRC),"^",2)
|
---|
| 244 | ; text IEN's in 757.01
|
---|
| 245 | I '$D(^LEX(757.01,"B",$E($$UP^XLFSTR(LEXTEXT),1,63))) Q "-1^expression unknown in Lexicon"
|
---|
| 246 | ; build an array of expression IENs for text
|
---|
| 247 | S EXIEN=""
|
---|
| 248 | F S EXIEN=$O(^LEX(757.01,"B",$$UP^XLFSTR(LEXTEXT),EXIEN)) Q:EXIEN="" D
|
---|
| 249 | .S EXP(EXIEN)=""
|
---|
| 250 | ; scan array to find code for expression (LEXTEXT) for code system (LEXSRC)
|
---|
| 251 | S EXIEN=""
|
---|
| 252 | K LEXW
|
---|
| 253 | S (FOUND,FINDS)=0
|
---|
| 254 | F S EXIEN=$O(EXP(EXIEN)) Q:EXIEN="" D
|
---|
| 255 | .S MCIEN=$P(^LEX(757.01,EXIEN,1),U)
|
---|
| 256 | .S EXPTYP=$P(^LEX(757.011,$P(^LEX(757.01,EXIEN,1),U,2),0),U)
|
---|
| 257 | .S CIEN=""
|
---|
| 258 | .F S CIEN=$O(^LEX(757.02,"AMC",MCIEN,CIEN)) Q:CIEN="" D
|
---|
| 259 | ..I $P($$CSYSMNEM($P(^LEX(757.02,CIEN,0),U,3)),U,2)=LEXSRC D
|
---|
| 260 | ...S CODE=$P(^LEX(757.02,CIEN,0),U,2)
|
---|
| 261 | ...S (HIER,HIERNAM)=""
|
---|
| 262 | ...I LEXSUB'="" D
|
---|
| 263 | ....K LAR
|
---|
| 264 | ....S LAR=$$CODE(CODE,"SCT",,"LAR")
|
---|
| 265 | ....S HIER=$P(LAR(0),U,2)
|
---|
| 266 | ....S HIERNAM=$P(^LEXT(757.2,$O(^LEXT(757.2,"AA",LEXSUB,"")),0),U)
|
---|
| 267 | ...I LEXSUB'="",HIER'=HIERNAM Q
|
---|
| 268 | ...S FOUND=1
|
---|
| 269 | ...S FINDS=FINDS+1
|
---|
| 270 | ...S LEXW(CODE)=EXPTYP
|
---|
| 271 | M LEX=LEXW
|
---|
| 272 | I $D(LEXRAY),LEXRAY'="LEX" M @LEXRAY=LEX K LEX
|
---|
| 273 | Q FOUND_"^"_FINDS
|
---|
| 274 | ;
|
---|
| 275 | CSYSIEN(MNEM) ; return code system IEN for mnemonic
|
---|
| 276 | I '$D(^LEX(757.03,"B",MNEM)) Q "-1^code system unknown in Lexicon"
|
---|
| 277 | Q "1^"_$O(^LEX(757.03,"B",MNEM,""))
|
---|
| 278 | ;
|
---|
| 279 | CSYSMNEM(SIEN) ; return code system mnemonic for IEN
|
---|
| 280 | I '$D(^LEX(757.03,SIEN)) Q "-1^code system unknown in Lexicon"
|
---|
| 281 | Q "1^"_$P(^LEX(757.03,SIEN,0),"^")
|
---|
| 282 | ;
|
---|
| 283 | INTDAT(X) ; convert date from external format to VA internal format
|
---|
| 284 | N Y
|
---|
| 285 | D ^%DT
|
---|
| 286 | Q Y
|
---|