Changeset 222


Ignore:
Timestamp:
Oct 21, 2008, 10:06:59 AM (16 years ago)
Author:
George Lilly
Message:

Alert SNOMED research routines

Location:
ccr/trunk/p
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • ccr/trunk/p/CCRUTIL.m

    r219 r222  
    8686 ;
    8787 N LEXIEN
    88  I $O(^LEX(757.21,"ADIS",DNAME))'="" D  ; IEN FOUND FOR THIS DRUG
    89  . S LEXIEN=$O(^LEX(757.21,"ADIS",DNAME)) ; GET THE IEN IN THE LEXICON
     88 I $O(^LEX(757.21,"ADIS",DNAME,""))'="" D  ; IEN FOUND FOR THIS DRUG
     89 . S LEXIEN=$O(^LEX(757.21,"ADIS",DNAME,"")) ; GET THE IEN IN THE LEXICON
     90 . W LEXIEN,!
    9091 . S RTN(1)=$P(^LEX(757.02,LEXIEN,0),"^",2) ; SNOMED CODE IN P2
    9192 . S RTN(0)=1 ; ONE THING RETURNED
     
    9899 D DA2SNO(.DARTN,DANAME) ; CALL THE LOOKUP ROUTINE
    99100 I DARTN(0)>0 D  ; GOT RESULTS
    100  . W !,RTN(1) ;PRINT THE SNOMED CODE
     101 . W !,DARTN(1) ;PRINT THE SNOMED CODE
    101102 E  W !,"NOT FOUND",!
    102103 Q
    103104 ;
    104 DASNALL ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL
     105DASNALL(WHICH) ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL
    105106 ; ASSOCIATED SNOMED CODES
    106107 N DASTMP,DASIEN,DASNO
    107108 S DASTMP=""
    108  F  S DASTMP=$O(^LEX(757.21,"ANUR",DASTMP)) Q:DASTMP=""  D  ; NAME OF MED
    109  . S DASIEN=$O(^LEX(757.21,"ANUR",DASTMP)) ; IEN OF MED
     109 F  S DASTMP=$O(^LEX(757.21,WHICH,DASTMP)) Q:DASTMP=""  D  ; NAME OF MED
     110 . S DASIEN=$O(^LEX(757.21,WHICH,DASTMP,"")) ; IEN OF MED
    110111 . S DASNO=$P(^LEX(757.02,DASIEN,0),"^",2) ; SNOMED CODE FOR ENTRY
    111112 . W DASTMP,"=",DASNO,! ; PRINT IT OUT
  • ccr/trunk/p/GPLSNOA.m

    r221 r222  
    4040    . ;D CCRRPC^GPLCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR
    4141    . W SNOIEN,@GMRBASE@(SNOIEN,0),!
    42     . N SNORTN ; RETURN ARRAY
    43     . D TEXTRPC(.SNORTN,$P(@GMRBASE@(SNOIEN,0),"^",1))
    44     . W SNORTN(1),!
     42    . N SNORTN,TTERM ; RETURN ARRAY
     43    . S TTERM=$P(@GMRBASE@(SNOIEN,0),"^",1)_" ALLERGY"
     44    . D TEXTRPC(.SNORTN,TTERM)
     45    . I $D(SNORTN) ZWR SNORTN
    4546    . K @SNOBASE@("VARS",SNOIEN) ; CLEAR OUT OLD VARS
     47    . I $P(TTMP,"^",1)=1 S @SNOBASE@("VARS",SNOIEN)=TTERM_"^"_TTMP_"^"_SNORTN(0)
    4648    . ;
    4749    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
     
    6264TEXTRPC(ORTN,ITEXT) ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN
    6365 ;
     66 ;N TTMP
    6467 W ITEXT,!
    65  W $$TEXT^LEXTRAN(ITEXT,"","","SCT",.ORTN)
     68 S TTMP=$$TEXT^LEXTRAN(ITEXT,"","","SCT","ORTN")
    6669 Q
    6770 ;
     
    98101    S SBASE=$NA(@SNOBASE@("VARS",SDFN))
    99102    D APOST("SATTR","SNOTBL","DONE")
     103    I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE")
     104    I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE")
    100105    Q SATTR  ; GPL
    101106    I $D(@SBASE@("PROBLEMS",1)) D  ;
Note: See TracChangeset for help on using the changeset viewer.