iSharkFly-Open
/
VistA-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Alert SNOMED research routines

This commit is contained in:
george 2008-10-21 14:06:59 +00:00
parent 4da5eec12c
commit 4ed2788c39
2 changed files with 16 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
p/CCRUTIL.m
View File

@ -85,8 +85,9 @@ DA2SNO(RTN,DNAME) ; LOOK UP DRUG ALLERGY CODE IN ^LEX
; 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
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
E S RTN(0)=0 ; NOT FOUND
@ -97,16 +98,16 @@ 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
. 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
Q

13
p/GPLSNOA.m
View File

@ -39,10 +39,12 @@ ANALYZE(BEGIEN,IENCNT) ; SNOMED RETRIEVAL ANALYSIS ROUTINE
F SNOI=1:1:IENCNT D Q:+SNOIEN=0 ; FOR IENCNT NUMBER OF PATIENTS OR END
. ;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
. ;
@ -61,8 +63,9 @@ ANALYZE(BEGIEN,IENCNT) ; SNOMED RETRIEVAL ANALYSIS ROUTINE
;
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
;
ASETUP ; SET UP GLOBALS AND VARS SNOBASE AND SNOTBL
@ -97,6 +100,8 @@ SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
N SBASE,SATTR
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 ;
. D APOST("SATTR","SNOTBL","PROBLEMS")