source: ccr/trunk/p/C0CSNOA.m@ 1112

Last change on this file since 1112 was 391, checked in by George Lilly, 16 years ago

name spacing the package to C0C ... removing all GPL references

File size: 8.0 KB
Line 
1C0CSNOA ; 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 ;
25ANALYZE(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 ;
65TEXTRPC(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 ;
72ASETUP ; 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 ;
80AINIT ; 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
89APOST(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
100SETATTR(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 ;
123RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL SNO TMP VALUES
124 K ^TMP("C0CSNO","RESUME")
125 K ^TMP("C0CSNO")
126 Q
127 ;
128CLIST ; 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 ;
142CPUSH(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 ;
178REUSE ; 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 ;
Note: See TracBrowser for help on using the repository browser.