Changeset 222 for ccr/trunk/p

Timestamp:

Oct 21, 2008, 10:06:59 AM (16 years ago)

Author:

George Lilly

Message:

Alert SNOMED research routines

Location:

ccr/trunk/p

Files:

• CCRUTIL.m (modified) (2 diffs)
• GPLSNOA.m (modified) (3 diffs)

ccr/trunk/p/CCRUTIL.m

@@ -86 +86 @@
  ;
  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
+ 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
+ . W LEXIEN,!
  . S RTN(1)=$P(^LEX(757.02,LEXIEN,0),"^",2) ; SNOMED CODE IN P2
  . S RTN(0)=1 ; ONE THING RETURNED
@@ -98 +99 @@
  D DA2SNO(.DARTN,DANAME) ; CALL THE LOOKUP ROUTINE
  I DARTN(0)>0 D  ; GOT RESULTS
- . W !,RTN(1) ;PRINT THE SNOMED CODE
+ . W !,DARTN(1) ;PRINT THE SNOMED CODE
  E  W !,"NOT FOUND",!
  Q
  ;
-DASNALL ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL
+DASNALL(WHICH) ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL
  ; ASSOCIATED SNOMED CODES
  N DASTMP,DASIEN,DASNO
  S DASTMP=""
- F  S DASTMP=$O(^LEX(757.21,"ANUR",DASTMP)) Q:DASTMP=""  D  ; NAME OF MED
- . S DASIEN=$O(^LEX(757.21,"ANUR",DASTMP)) ; IEN OF MED
+ F  S DASTMP=$O(^LEX(757.21,WHICH,DASTMP)) Q:DASTMP=""  D  ; NAME OF MED
+ . S DASIEN=$O(^LEX(757.21,WHICH,DASTMP,"")) ; IEN OF MED
  . S DASNO=$P(^LEX(757.02,DASIEN,0),"^",2) ; SNOMED CODE FOR ENTRY
  . W DASTMP,"=",DASNO,! ; PRINT IT OUT

ccr/trunk/p/GPLSNOA.m

@@ -40 +40 @@
     . ;D CCRRPC^GPLCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR
     . W SNOIEN,@GMRBASE@(SNOIEN,0),!
-    . N SNORTN ; RETURN ARRAY
-    . D TEXTRPC(.SNORTN,$P(@GMRBASE@(SNOIEN,0),"^",1))
-    . W SNORTN(1),!
+    . N SNORTN,TTERM ; RETURN ARRAY
+    . S TTERM=$P(@GMRBASE@(SNOIEN,0),"^",1)_" ALLERGY"
+    . D TEXTRPC(.SNORTN,TTERM)
+    . I $D(SNORTN) ZWR SNORTN
     . K @SNOBASE@("VARS",SNOIEN) ; CLEAR OUT OLD VARS
+    . I $P(TTMP,"^",1)=1 S @SNOBASE@("VARS",SNOIEN)=TTERM_"^"_TTMP_"^"_SNORTN(0)
     . ;
     . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
@@ -62 +64 @@
 TEXTRPC(ORTN,ITEXT) ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN
  ;
+ ;N TTMP
  W ITEXT,!
- W $$TEXT^LEXTRAN(ITEXT,"","","SCT",.ORTN)
+ S TTMP=$$TEXT^LEXTRAN(ITEXT,"","","SCT","ORTN")
  Q
  ;
@@ -98 +101 @@
     S SBASE=$NA(@SNOBASE@("VARS",SDFN))
     D APOST("SATTR","SNOTBL","DONE")
+    I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE")
+    I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE")
     Q SATTR  ; GPL
     I $D(@SBASE@("PROBLEMS",1)) D  ;