Changeset 1586 for ccr/trunk/p/C0CSNOA.m
- Timestamp:
- Oct 30, 2012, 1:11:02 PM (13 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/C0CSNOA.m (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CSNOA.m
r1544 r1586 1 1 C0CSNOA ; CCDCCR/GPL - SNOMED CT ANALYSIS ROUTINES; 10/14/08 2 ;;1.2;C 0C;;May 11, 2012;Build 472 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50 3 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 4 ; 7 ; This program is free software;you can redistribute it and/or modify8 ; it under the terms of the GNU General Public License as published by9 ; the Free Software Foundation; either version 2 of the License, or10 ; (at your option) any later version.5 ; This program is free software: you can redistribute it and/or modify 6 ; it under the terms of the GNU Affero General Public License as 7 ; published by the Free Software Foundation, either version 3 of the 8 ; License, or (at your option) any later version. 11 9 ; 12 ; This program is distributed in the hope that it will be useful,13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the15 ; GNUGeneral Public License for more details.10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU Affero General Public License for more details. 16 14 ; 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 15 ; You should have received a copy of the GNU Affero General Public License 16 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 24 17 ; 25 18 ANALYZE(BEGIEN,IENCNT) ; SNOMED RETRIEVAL ANALYSIS ROUTINE 26 ; BEGINS AT BEGIEN AND GOES FOR IENCNT DRUGS IN GMRD27 ; TO RESUME AT NEXT DRUG, USE BEGIEN=""28 ; USE RESET^C0CSNOA TO RESET TO TOP OF DRUG LIST29 ;30 N SNOARY,SNOTMP,SNOI,SNOIEN,RATTR31 N CCRGLO32 D ASETUP ; SET UP VARIABLES AND GLOBALS33 D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE34 I '$D(@SNOBASE@("RESUME")) S @SNOBASE@("RESUME")=$O(@GMRBASE@(1)) ;1ST TME35 S RESUME=@SNOBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN36 S SNOIEN=BEGIEN ; BEGIN WITH THE BEGIEN RECORD37 I SNOIEN="" S SNOIEN=RESUME38 I +SNOIEN=0 D Q ; AT THE END OF THE ALLERGY LIST39 . W "END OF DRUG LIST, CALL RESET^C0CSNOA",!40 F SNOI=1:1:IENCNT D Q:+SNOIEN=0 ; FOR IENCNT NUMBER OF PATIENTS OR END41 . ;D CCRRPC^C0CCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR42 . W SNOIEN,@GMRBASE@(SNOIEN,0),!43 . N SNORTN,TTERM ; RETURN ARRAY44 . S TTERM=$P(@GMRBASE@(SNOIEN,0),"^",1)_" ALLERGY"45 . D TEXTRPC(.SNORTN,TTERM)46 .I $D(SNORTN) ZWR SNORTN47 . K @SNOBASE@("VARS",SNOIEN) ; CLEAR OUT OLD VARS48 . I $P(TTMP,"^",1)=1 S @SNOBASE@("VARS",SNOIEN)=TTERM_"^"_TTMP_"^"_SNORTN(0)49 . ;50 . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP51 . ;52 . S RATTR=$$SETATTR(SNOIEN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS53 . S @SNOBASE@("ATTR",SNOIEN)=RATTR ; SAVE THE ATRIBUTES FOR THIS DRUG54 . ;55 . N CATNAME,CATTBL56 . S CATNAME=""57 . D CPUSH(.CATNAME,SNOBASE,"SNOTBL",SNOIEN,RATTR) ; ADD TO CATEGORY58 . ; W "CATEGORY NAME: ",CATNAME,!59 . ;60 . S SNOIEN=$O(@GMRBASE@(SNOIEN)) ; NEXT RECORD61 . S @SNOBASE@("RESUME")=SNOIEN ; WHERE WE ARE LEAVING OFF THIS RUN62 ; D PARY^C0CXPATH(@SNOBASE@("ATTRTBL"))63 Q64 ;19 ; BEGINS AT BEGIEN AND GOES FOR IENCNT DRUGS IN GMRD 20 ; TO RESUME AT NEXT DRUG, USE BEGIEN="" 21 ; USE RESET^C0CSNOA TO RESET TO TOP OF DRUG LIST 22 ; 23 N SNOARY,SNOTMP,SNOI,SNOIEN,RATTR 24 N CCRGLO 25 D ASETUP ; SET UP VARIABLES AND GLOBALS 26 D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE 27 I '$D(@SNOBASE@("RESUME")) S @SNOBASE@("RESUME")=$O(@GMRBASE@(1)) ;1ST TME 28 S RESUME=@SNOBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN 29 S SNOIEN=BEGIEN ; BEGIN WITH THE BEGIEN RECORD 30 I SNOIEN="" S SNOIEN=RESUME 31 I +SNOIEN=0 D Q ; AT THE END OF THE ALLERGY LIST 32 . W "END OF DRUG LIST, CALL RESET^C0CSNOA",! 33 F SNOI=1:1:IENCNT D Q:+SNOIEN=0 ; FOR IENCNT NUMBER OF PATIENTS OR END 34 . ;D CCRRPC^C0CCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR 35 . W SNOIEN,@GMRBASE@(SNOIEN,0),! 36 . N SNORTN,TTERM ; RETURN ARRAY 37 . S TTERM=$P(@GMRBASE@(SNOIEN,0),"^",1)_" ALLERGY" 38 . D TEXTRPC(.SNORTN,TTERM) 39 . ; I $D(SNORTN) ZWR SNORTN 40 . K @SNOBASE@("VARS",SNOIEN) ; CLEAR OUT OLD VARS 41 . I $P(TTMP,"^",1)=1 S @SNOBASE@("VARS",SNOIEN)=TTERM_"^"_TTMP_"^"_SNORTN(0) 42 . ; 43 . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP 44 . ; 45 . S RATTR=$$SETATTR(SNOIEN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS 46 . S @SNOBASE@("ATTR",SNOIEN)=RATTR ; SAVE THE ATRIBUTES FOR THIS DRUG 47 . ; 48 . N CATNAME,CATTBL 49 . S CATNAME="" 50 . D CPUSH(.CATNAME,SNOBASE,"SNOTBL",SNOIEN,RATTR) ; ADD TO CATEGORY 51 . ; W "CATEGORY NAME: ",CATNAME,! 52 . ; 53 . S SNOIEN=$O(@GMRBASE@(SNOIEN)) ; NEXT RECORD 54 . S @SNOBASE@("RESUME")=SNOIEN ; WHERE WE ARE LEAVING OFF THIS RUN 55 ; D PARY^C0CXPATH(@SNOBASE@("ATTRTBL")) 56 Q 57 ; 65 58 TEXTRPC(ORTN,ITEXT) ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN 66 59 ; … … 71 64 ; 72 65 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 TABLE77 S ^TMP("C0CSNO","TABLES","SNOTBL")=SNOTBL ; TABLE OF TABLES78 Q79 ;66 I '$D(SNOBASE) S SNOBASE=$NA(^TMP("C0CSNO")) 67 I '$D(@SNOBASE) S @SNOBASE="" 68 I '$D(GMRBASE) S GMRBASE=$NA(^GMRD(120.82)) 69 I '$D(SNOTBL) S SNOTBL=$NA(^TMP("C0CSNO","SNOTBL","TABLE")) ; ATTR TABLE 70 S ^TMP("C0CSNO","TABLES","SNOTBL")=SNOTBL ; TABLE OF TABLES 71 Q 72 ; 80 73 AINIT ; INITIALIZE ATTRIBUTE TABLE 81 I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS82 K @SNOTBL83 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 Q74 I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS 75 K @SNOTBL 76 D APUSH^C0CRIMA(SNOTBL,"CODE") 77 D APUSH^C0CRIMA(SNOTBL,"NOCODE") 78 D APUSH^C0CRIMA(SNOTBL,"MULTICODE") 79 D APUSH^C0CRIMA(SNOTBL,"SUBMULTI") 80 D APUSH^C0CRIMA(SNOTBL,"DONE") 81 Q 89 82 APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL 90 ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING91 ; PTBL IS THE NAME OF A TABLE IN @SNOBASE@("TABLES") - "SNOTBL"=ALL VALUES92 ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))93 I '$D(SNOBASE) D ASETUP ; FOR COMMANDLINE PROCESSING94 N USETBL95 I '$D(@SNOBASE@("TABLES",PTBL)) D Q ; NO TABLE96 . W "ERROR NO SUCH TABLE",!97 S USETBL=@SNOBASE@("TABLES",PTBL)98 S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL99 Q83 ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING 84 ; PTBL IS THE NAME OF A TABLE IN @SNOBASE@("TABLES") - "SNOTBL"=ALL VALUES 85 ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL)) 86 I '$D(SNOBASE) D ASETUP ; FOR COMMANDLINE PROCESSING 87 N USETBL 88 I '$D(@SNOBASE@("TABLES",PTBL)) D Q ; NO TABLE 89 . W "ERROR NO SUCH TABLE",! 90 S USETBL=@SNOBASE@("TABLES",PTBL) 91 S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL 92 Q 100 93 SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS 101 N SBASE,SATTR102 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 ; C0C107 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 VARIABLES112 . D APOST("SATTR","SNOTBL","MEDS")113 . N ZR,ZI114 . D GETPA^C0CRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES115 . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN116 . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS117 . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","SNOTBL","MEDSCODE") ;CODES118 . ; D PATD^C0CSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES119 D APOST("SATTR","SNOTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED120 ; W "ATTRIBUTES: ",SATTR,!121 Q SATTR122 ;94 N SBASE,SATTR 95 S SBASE=$NA(@SNOBASE@("VARS",SDFN)) 96 D APOST("SATTR","SNOTBL","DONE") 97 I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE") 98 I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE") 99 Q SATTR ; C0C 100 I $D(@SBASE@("PROBLEMS",1)) D ; 101 . D APOST("SATTR","SNOTBL","PROBLEMS") 102 . ; W "POSTING PROBLEMS",! 103 I $D(@SBASE@("VITALS",1)) D APOST("SATTR","SNOTBL","VITALS") 104 I $D(@SBASE@("MEDS",1)) D ; IF THE PATIENT HAS MEDS VARIABLES 105 . D APOST("SATTR","SNOTBL","MEDS") 106 . N ZR,ZI 107 . D GETPA^C0CRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES 108 . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN 109 . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS 110 . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","SNOTBL","MEDSCODE") ;CODES 111 . ; D PATD^C0CSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES 112 D APOST("SATTR","SNOTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED 113 ; W "ATTRIBUTES: ",SATTR,! 114 Q SATTR 115 ; 123 116 RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL SNO TMP VALUES 124 K ^TMP("C0CSNO","RESUME")125 K ^TMP("C0CSNO")126 Q127 ;117 K ^TMP("C0CSNO","RESUME") 118 K ^TMP("C0CSNO") 119 Q 120 ; 128 121 CLIST ; LIST THE CATEGORIES 129 ;130 I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS131 N CLBASE,CLNUM,ZI,CLIDX132 S CLBASE=$NA(@SNOBASE@("SNOTBL","CATS"))133 S CLNUM=@CLBASE@(0)134 F ZI=1:1:CLNUM D ; LOOP THROUGH THE CATEGORIES135 . 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 Q141 ;122 ; 123 I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS 124 N CLBASE,CLNUM,ZI,CLIDX 125 S CLBASE=$NA(@SNOBASE@("SNOTBL","CATS")) 126 S CLNUM=@CLBASE@(0) 127 F ZI=1:1:CLNUM D ; LOOP THROUGH THE CATEGORIES 128 . S CLIDX=@CLBASE@(ZI) 129 . W "(",$P(@CLBASE@(CLIDX),"^",1) 130 . W ":",$P(@CLBASE@(CLIDX),"^",2),") " 131 . W CLIDX,! 132 ; D PARY^C0CXPATH(CLBASE) 133 Q 134 ; 142 135 CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES 143 ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT144 ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE145 ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME146 ; 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 CATEGORIES149 ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY150 ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING151 ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY152 ; NUMBER IE CTBL_X(CDFN)=""153 ;154 ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST155 S CCTBL=$NA(@CBASE@(CTBL,"CATS"))156 ; W "CBASE: ",CCTBL,!157 ;158 I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY159 . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY160 . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY161 . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT162 . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY163 . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME164 . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0165 ;166 S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY167 S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT168 S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK169 ;170 S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED171 ;172 S CPATLIST=$NA(@CBASE@(CTBL,"IENS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT173 ; W "IENS BASE: ",CPATLIST,!174 S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST175 ;176 Q177 ;136 ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT 137 ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE 138 ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME 139 ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES, 140 ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X" 141 ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES 142 ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY 143 ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING 144 ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY 145 ; NUMBER IE CTBL_X(CDFN)="" 146 ; 147 ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST 148 S CCTBL=$NA(@CBASE@(CTBL,"CATS")) 149 ; W "CBASE: ",CCTBL,! 150 ; 151 I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY 152 . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY 153 . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY 154 . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT 155 . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY 156 . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME 157 . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0 158 ; 159 S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY 160 S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT 161 S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK 162 ; 163 S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED 164 ; 165 S CPATLIST=$NA(@CBASE@(CTBL,"IENS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT 166 ; W "IENS BASE: ",CPATLIST,! 167 S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST 168 ; 169 Q 170 ; 178 171 REUSE ; GET SAVED VALUES FROM ^TMP("C0CSAV") AND PUT THEM IN A DATABASE 179 172 ; … … 183 176 S SAVBASE=$NA(^TMP("C0CSAV","VARS")) 184 177 S SNOI="" 185 F D Q:$O(@SAVBASE@(SNOI))="" ;THE WHOLE LIST178 F D Q:$O(@SAVBASE@(SNOI))="" ;THE WHOLE LIST 186 179 . S SNOI=$O(@SAVBASE@(SNOI)) 187 180 . S SNOJ=@SAVBASE@(SNOI)
Note:
See TracChangeset
for help on using the changeset viewer.
