Index: ccr/trunk/p/CCRUTIL.m
===================================================================
--- ccr/trunk/p/CCRUTIL.m	(revision 215)
+++ ccr/trunk/p/CCRUTIL.m	(revision 217)
@@ -79,2 +79,25 @@
  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
+ ;