1 | C0CSNOA ; CCDCCR/GPL - SNOMED CT ANALYSIS ROUTINES; 10/14/08
|
---|
2 | ;;0.1;CCDCCR;nopatch;noreleasedate
|
---|
3 | ;Copyright 2008,2009 George Lilly, University of Minnesota.
|
---|
4 | ;Licensed under the terms of the GNU General Public License.
|
---|
5 | ;See attached copy of the License.
|
---|
6 | ;
|
---|
7 | ;This program is free software; you can redistribute it and/or modify
|
---|
8 | ;it under the terms of the GNU General Public License as published by
|
---|
9 | ;the Free Software Foundation; either version 2 of the License, or
|
---|
10 | ;(at your option) any later version.
|
---|
11 | ;
|
---|
12 | ;This program is distributed in the hope that it will be useful,
|
---|
13 | ;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
14 | ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
---|
15 | ;GNU General Public License for more details.
|
---|
16 | ;
|
---|
17 | ;You should have received a copy of the GNU General Public License along
|
---|
18 | ;with this program; if not, write to the Free Software Foundation, Inc.,
|
---|
19 | ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
---|
20 | ;
|
---|
21 | ; THESE ROUTINES ANALYZE THE POTENTIAL RETRIEVAL OF SNOMED CT CODES
|
---|
22 | ; FOR PATIENT DRUG ALLERGIES FOR INCLUSION IN THE CCR OR CCD
|
---|
23 | ; USING THE VISTA LEXICON ^LEX
|
---|
24 | ;
|
---|
25 | ANALYZE(BEGIEN,IENCNT) ; SNOMED RETRIEVAL ANALYSIS ROUTINE
|
---|
26 | ; BEGINS AT BEGIEN AND GOES FOR IENCNT DRUGS IN GMRD
|
---|
27 | ; TO RESUME AT NEXT DRUG, USE BEGIEN=""
|
---|
28 | ; USE RESET^C0CSNOA TO RESET TO TOP OF DRUG LIST
|
---|
29 | ;
|
---|
30 | N SNOARY,SNOTMP,SNOI,SNOIEN,RATTR
|
---|
31 | N CCRGLO
|
---|
32 | D ASETUP ; SET UP VARIABLES AND GLOBALS
|
---|
33 | D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
|
---|
34 | I '$D(@SNOBASE@("RESUME")) S @SNOBASE@("RESUME")=$O(@GMRBASE@(1)) ;1ST TME
|
---|
35 | S RESUME=@SNOBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
|
---|
36 | S SNOIEN=BEGIEN ; BEGIN WITH THE BEGIEN RECORD
|
---|
37 | I SNOIEN="" S SNOIEN=RESUME
|
---|
38 | I +SNOIEN=0 D Q ; AT THE END OF THE ALLERGY LIST
|
---|
39 | . W "END OF DRUG LIST, CALL RESET^C0CSNOA",!
|
---|
40 | F SNOI=1:1:IENCNT D Q:+SNOIEN=0 ; FOR IENCNT NUMBER OF PATIENTS OR END
|
---|
41 | . ;D CCRRPC^C0CCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR
|
---|
42 | . W SNOIEN,@GMRBASE@(SNOIEN,0),!
|
---|
43 | . N SNORTN,TTERM ; RETURN ARRAY
|
---|
44 | . S TTERM=$P(@GMRBASE@(SNOIEN,0),"^",1)_" ALLERGY"
|
---|
45 | . D TEXTRPC(.SNORTN,TTERM)
|
---|
46 | . I $D(SNORTN) ZWR SNORTN
|
---|
47 | . K @SNOBASE@("VARS",SNOIEN) ; CLEAR OUT OLD VARS
|
---|
48 | . I $P(TTMP,"^",1)=1 S @SNOBASE@("VARS",SNOIEN)=TTERM_"^"_TTMP_"^"_SNORTN(0)
|
---|
49 | . ;
|
---|
50 | . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
|
---|
51 | . ;
|
---|
52 | . S RATTR=$$SETATTR(SNOIEN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
|
---|
53 | . S @SNOBASE@("ATTR",SNOIEN)=RATTR ; SAVE THE ATRIBUTES FOR THIS DRUG
|
---|
54 | . ;
|
---|
55 | . N CATNAME,CATTBL
|
---|
56 | . S CATNAME=""
|
---|
57 | . D CPUSH(.CATNAME,SNOBASE,"SNOTBL",SNOIEN,RATTR) ; ADD TO CATEGORY
|
---|
58 | . ; W "CATEGORY NAME: ",CATNAME,!
|
---|
59 | . ;
|
---|
60 | . S SNOIEN=$O(@GMRBASE@(SNOIEN)) ; NEXT RECORD
|
---|
61 | . S @SNOBASE@("RESUME")=SNOIEN ; WHERE WE ARE LEAVING OFF THIS RUN
|
---|
62 | ; D PARY^C0CXPATH(@SNOBASE@("ATTRTBL"))
|
---|
63 | Q
|
---|
64 | ;
|
---|
65 | TEXTRPC(ORTN,ITEXT) ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN
|
---|
66 | ;
|
---|
67 | ;N TTMP
|
---|
68 | W ITEXT,!
|
---|
69 | S TTMP=$$TEXT^LEXTRAN(ITEXT,"","","SCT","ORTN")
|
---|
70 | Q
|
---|
71 | ;
|
---|
72 | ASETUP ; SET UP GLOBALS AND VARS SNOBASE AND SNOTBL
|
---|
73 | I '$D(SNOBASE) S SNOBASE=$NA(^TMP("C0CSNO"))
|
---|
74 | I '$D(@SNOBASE) S @SNOBASE=""
|
---|
75 | I '$D(GMRBASE) S GMRBASE=$NA(^GMRD(120.82))
|
---|
76 | I '$D(SNOTBL) S SNOTBL=$NA(^TMP("C0CSNO","SNOTBL","TABLE")) ; ATTR TABLE
|
---|
77 | S ^TMP("C0CSNO","TABLES","SNOTBL")=SNOTBL ; TABLE OF TABLES
|
---|
78 | Q
|
---|
79 | ;
|
---|
80 | AINIT ; INITIALIZE ATTRIBUTE TABLE
|
---|
81 | I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
|
---|
82 | K @SNOTBL
|
---|
83 | D APUSH^C0CRIMA(SNOTBL,"CODE")
|
---|
84 | D APUSH^C0CRIMA(SNOTBL,"NOCODE")
|
---|
85 | D APUSH^C0CRIMA(SNOTBL,"MULTICODE")
|
---|
86 | D APUSH^C0CRIMA(SNOTBL,"SUBMULTI")
|
---|
87 | D APUSH^C0CRIMA(SNOTBL,"DONE")
|
---|
88 | Q
|
---|
89 | APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
|
---|
90 | ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
|
---|
91 | ; PTBL IS THE NAME OF A TABLE IN @SNOBASE@("TABLES") - "SNOTBL"=ALL VALUES
|
---|
92 | ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
|
---|
93 | I '$D(SNOBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
|
---|
94 | N USETBL
|
---|
95 | I '$D(@SNOBASE@("TABLES",PTBL)) D Q ; NO TABLE
|
---|
96 | . W "ERROR NO SUCH TABLE",!
|
---|
97 | S USETBL=@SNOBASE@("TABLES",PTBL)
|
---|
98 | S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
|
---|
99 | Q
|
---|
100 | SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
|
---|
101 | N SBASE,SATTR
|
---|
102 | S SBASE=$NA(@SNOBASE@("VARS",SDFN))
|
---|
103 | D APOST("SATTR","SNOTBL","DONE")
|
---|
104 | I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE")
|
---|
105 | I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE")
|
---|
106 | Q SATTR ; C0C
|
---|
107 | I $D(@SBASE@("PROBLEMS",1)) D ;
|
---|
108 | . D APOST("SATTR","SNOTBL","PROBLEMS")
|
---|
109 | . ; W "POSTING PROBLEMS",!
|
---|
110 | I $D(@SBASE@("VITALS",1)) D APOST("SATTR","SNOTBL","VITALS")
|
---|
111 | I $D(@SBASE@("MEDS",1)) D ; IF THE PATIENT HAS MEDS VARIABLES
|
---|
112 | . D APOST("SATTR","SNOTBL","MEDS")
|
---|
113 | . N ZR,ZI
|
---|
114 | . D GETPA^C0CRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
|
---|
115 | . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
|
---|
116 | . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
|
---|
117 | . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","SNOTBL","MEDSCODE") ;CODES
|
---|
118 | . ; D PATD^C0CSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
|
---|
119 | D APOST("SATTR","SNOTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
|
---|
120 | ; W "ATTRIBUTES: ",SATTR,!
|
---|
121 | Q SATTR
|
---|
122 | ;
|
---|
123 | RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL SNO TMP VALUES
|
---|
124 | K ^TMP("C0CSNO","RESUME")
|
---|
125 | K ^TMP("C0CSNO")
|
---|
126 | Q
|
---|
127 | ;
|
---|
128 | CLIST ; LIST THE CATEGORIES
|
---|
129 | ;
|
---|
130 | I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
|
---|
131 | N CLBASE,CLNUM,ZI,CLIDX
|
---|
132 | S CLBASE=$NA(@SNOBASE@("SNOTBL","CATS"))
|
---|
133 | S CLNUM=@CLBASE@(0)
|
---|
134 | F ZI=1:1:CLNUM D ; LOOP THROUGH THE CATEGORIES
|
---|
135 | . S CLIDX=@CLBASE@(ZI)
|
---|
136 | . W "(",$P(@CLBASE@(CLIDX),"^",1)
|
---|
137 | . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
|
---|
138 | . W CLIDX,!
|
---|
139 | ; D PARY^C0CXPATH(CLBASE)
|
---|
140 | Q
|
---|
141 | ;
|
---|
142 | CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
|
---|
143 | ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
|
---|
144 | ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
|
---|
145 | ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
|
---|
146 | ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
|
---|
147 | ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
|
---|
148 | ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
|
---|
149 | ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
|
---|
150 | ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
|
---|
151 | ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
|
---|
152 | ; NUMBER IE CTBL_X(CDFN)=""
|
---|
153 | ;
|
---|
154 | ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
|
---|
155 | S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
|
---|
156 | ; W "CBASE: ",CCTBL,!
|
---|
157 | ;
|
---|
158 | I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY
|
---|
159 | . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
|
---|
160 | . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
|
---|
161 | . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
|
---|
162 | . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
|
---|
163 | . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
|
---|
164 | . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
|
---|
165 | ;
|
---|
166 | S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
|
---|
167 | S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
|
---|
168 | S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
|
---|
169 | ;
|
---|
170 | S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
|
---|
171 | ;
|
---|
172 | S CPATLIST=$NA(@CBASE@(CTBL,"IENS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
|
---|
173 | ; W "IENS BASE: ",CPATLIST,!
|
---|
174 | S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
|
---|
175 | ;
|
---|
176 | Q
|
---|
177 | ;
|
---|
178 | REUSE ; GET SAVED VALUES FROM ^TMP("C0CSAV") AND PUT THEM IN A DATABASE
|
---|
179 | ;
|
---|
180 | D ASETUP
|
---|
181 | D AINIT
|
---|
182 | N SNOI,SNOJ,SNOK,SNOSNO,SNOSEC,SNOIEN,SNOOLD,SNOSRCH
|
---|
183 | S SAVBASE=$NA(^TMP("C0CSAV","VARS"))
|
---|
184 | S SNOI=""
|
---|
185 | F D Q:$O(@SAVBASE@(SNOI))="" ;THE WHOLE LIST
|
---|
186 | . S SNOI=$O(@SAVBASE@(SNOI))
|
---|
187 | . S SNOJ=@SAVBASE@(SNOI)
|
---|
188 | . S SNOK=$P($P(SNOJ,"^",1)," ALLERGY",1)
|
---|
189 | . S SNOSRCH=$P(SNOJ,"^",1) ;SEARCH TERM USED TO OBTAIN SNOMED CODE
|
---|
190 | . S SNOIEN=$P(SNOJ,"^",3) ; IEN OF ELEMENT IN LEXICON
|
---|
191 | . S SNOSNO=$P(SNOJ,"^",4) ; SNOMED CODE
|
---|
192 | . S SNOSEC=$P(SNOJ,"^",5) ; SECTION OF SNOMED FOR THIS CODE
|
---|
193 | . S SNOOLD=$P(SNOJ,"^",7) ; OLD NUMBER FOR THIS CODE
|
---|
194 | . W "SEARCH:",SNOSRCH," IEN:",SNOIEN," CODE:",SNOSNO," SEC:",SNOSEC," OLD:",SNOOLD,!
|
---|
195 | . W SNOK,!
|
---|
196 | . W SNOJ,!
|
---|
197 | Q
|
---|
198 | ;
|
---|