Changeset 217 for ccr/trunk/p

Timestamp:

Oct 12, 2008, 11:36:54 PM (16 years ago)

Author:

George Lilly

Message:

routine to look up SNOMED codes for drug allergies in the lexicon

File:

• ccr/trunk/p/CCRUTIL.m (modified) (1 diff)

ccr/trunk/p/CCRUTIL.m

@@ -79 +79 @@
  Q ZCNT
  ;
+DA2SNO(RTN,DNAME) ; LOOK UP DRUG ALLERGY CODE IN ^LEX
+ ; RETURNS AN ARRAY RTN PASSED BY REFERENCE
+ ; THIS ROUTINE CAN BE USED AS AN RPC
+ ; RTN(0) IS THE NUMBER OF ELEMENTS IN THE ARRAY
+ ; RTN(1) IS THE SNOMED CODE FOR THE DRUG ALLERGY
+ ;
+ N LEXIEN
+ I $O(^LEX(757.21,"ADIS",DNAME))'="" D  ; IEN FOUND FOR THIS DRUG
+ . S LEXIEN=$O(^LEX(757.21,"ADIS",DNAME)) ; GET THE IEN IN THE LEXICON
+ . S RTN(1)=$P(^LEX(757.02,LEXIEN,0),"^",2) ; SNOMED CODE IN P2
+ . S RTN(0)=1 ; ONE THING RETURNED
+ E  S RTN(0)=0 ; NOT FOUND
+ Q
+ ;
+DASNO(DANAME) ; PRINTS THE SNOMED CODE FOR ALLERGY TO DRUG DANAME
+ ;
+ N DARTN
+ D DA2SNO(.DARTN,DANAME) ; CALL THE LOOKUP ROUTINE
+ I DARTN(0)>0 D  ; GOT RESULTS
+ . W !,RTN(1) ;PRINT THE SNOMED CODE
+ E  W !,"NOT FOUND",!
+ Q
+ ;