Changeset 508 for ccr/trunk/p/C0CMED6.m
- Timestamp:
- May 21, 2009, 1:12:11 PM (15 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/C0CMED6.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CMED6.m
r424 r508 1 1 C0CMED6 ; WV/CCDCCR/SMH - Meds from RPMS: Outpatient Meds;01/10/09 2 ;;0.1;CCDCCR;;JUL 16,2008;3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 2 ;;1.0;C0C;;May 19, 2009; 3 ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU 4 ; General Public License See attached copy of the License. 5 ; 6 ; This program is free software; you can redistribute it and/or modify 7 ; it under the terms of the GNU General Public License as published by 8 ; the Free Software Foundation; either version 2 of the License, or 9 ; (at your option) any later version. 10 ; 11 ; This program is distributed in the hope that it will be useful, 12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ; GNU General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU General Public License along 17 ; with this program; if not, write to the Free Software Foundation, Inc., 18 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 19 ; 20 W "NO ENTRY FROM TOP",! 21 Q 22 ; 23 23 EXTRACT(MINXML,DFN,OUTXML,FLAGS) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 24 ; 25 ; MINXML and OUTXML are passed by name so globals can be used 26 ; MINXML will contain only the medications skeleton of the overall template 27 ; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool) 28 ; FLAGS are set-up in C0CMED. 29 ; 30 ; MEDS is return array from RPC. 31 ; MAP is a mapping variable map (store result) for each med 32 ; MED is holds each array element from MEDS(J), one medicine 33 ; J is a counter. 34 ; 35 ; GETRXS^BEHORXFN(ARRAYNAME,DFN,DAYS) will be the the API used. 36 ; This API has been developed by Medsphere for IHS for getting 37 ; Medications from RPMS. It has most of what we need. 38 ; API written by Doug Martin when he worked for Medsphere (thanks Doug!) 39 ; -- ARRAYNAME is passed by name (required) 40 ; -- DFN is passed by value (required) 41 ; -- DAYS is passed by value (optional; if not passed defaults to 365) 42 ; 43 ; Return: 44 ; ~Type^PharmID^Drug^InfRate^StopDt^RefRem^TotDose^UnitDose^OrderID 45 ; ^Status^LastFill^Chronic^Issued^Rx #^Provider^ 46 ; Status Reason^DEA Handling 47 ; 48 N MEDS,MEDS1,MAP 49 D GETRXS^BEHORXFN("MEDS1",DFN,$P($P(FLAGS,U,2),"-",2)) ; 2nd piece of FLAGS is # of days to retrieve, which comes in the form "T-360" 50 N ALL S ALL=+FLAGS 51 N ACTIVE S ACTIVE=$P(FLAGS,U,3) 52 N PENDING S PENDING=$P(FLAGS,U,4) 53 S @OUTXML@(0)=0 ;By default, no meds 54 ; If MEDS1 is not defined, then no meds 55 I '$D(MEDS1) QUIT 56 I DEBUG ZWR MEDS1,MINXML 57 N MEDCNT S MEDCNT=0 ; Med Count 58 ; The next line is a super line. It goes through the array return 59 ; and if the first characters are ~OP, it grabs the line. 60 ; This means that line is for a dispensed Outpatient Med. 61 ; That line has the metadata about the med that I need. 62 ; The next lines, however many, are the med and the sig. 63 ; I won't be using those because I have to get the sig parsed exactly. 64 N J S J="" F S J=$O(MEDS1(J)) Q:J="" I $E(MEDS1(J),1,3)="~OP" S MEDCNT=MEDCNT+1 S MEDS(MEDCNT)=MEDS1(J) 65 K MEDS1 66 S MEDCNT="" ; Initialize for $Order 67 F S MEDCNT=$O(MEDS(MEDCNT)) Q:MEDCNT="" D ; for each medication in the list 68 . I 'ALL,ACTIVE,$P(MEDS(MEDCNT),U,10)'="ACTIVE" QUIT 69 . I 'ALL,PENDING,$P(MEDS(MEDCNT),U,10)'="PENDING" QUIT 70 . I DEBUG W "MEDCNT IS ",MEDCNT,! 71 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCNT)) 72 . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED 73 . I DEBUG W "MAP= ",MAP,! 74 . S @MAP@("MEDOBJECTID")="MED"_MEDCNT ; MEDCNT FOR ID 75 . S @MAP@("MEDISSUEDATETXT")="Issue Date" 76 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,13)) 77 . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date" 78 . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,11)) 79 . S @MAP@("MEDRXNOTXT")="Prescription Number" 80 . S @MAP@("MEDRXNO")=$P(MEDS(MEDCNT),U,14) 81 . S @MAP@("MEDTYPETEXT")="Medication" 82 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 83 . S @MAP@("MEDSTATUSTEXT")=$P(MEDS(MEDCNT),U,10) 84 . ; Provider only provided in API as text, not DUZ. 85 . ; We need to get DUZ from filman file 52 (Prescription) 86 . ; Field 4; IEN is Piece 2 of Meds stripped of trailing characters. 87 . ; Note that I will use RXIEN several times later 88 . N RXIEN S RXIEN=+$P(MEDS(MEDCNT),U,2) 89 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52,RXIEN,4,"I") 90 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MEDS(MEDCNT),U,3) 91 . ; --- RxNorm Stuff 92 . ; 176.001 is the file for Concepts; 176.003 is the file for 93 . ; sources (i.e. for RxNorm Version) 94 . ; 95 . ; I use 176.001 for the Vista version of this routine (files 1-3) 96 . ; Since IHS does not have VUID's, I will be getting RxNorm codes 97 . ; using NDCs. My specially crafted index (sounds evil) named "NDC" 98 . ; is in file 176.002. The file is called RxNorm NDC to VUID. 99 . ; Except that I don't need the VUID, but it's there if I need it. 100 . ; 101 . ; We obviously need the NDC. That is easily obtained from the prescription. 102 . ; Field 27 in file 52 103 . N NDC S NDC=$$GET1^DIQ(52,RXIEN,27,"I") 104 . ; I discovered that file 176.002 might give you two codes for the NDC 105 . ; One for the Clinical Drug, and one for the ingredient. 106 . ; So the plan is to get the two RxNorm codes, and then find from 107 . ; file 176.001 which one is the Clinical Drug. 108 . ; ... I refactored this into GETRXN 109 . N RXNORM,SRCIEN,RXNNAME,RXNVER 110 . I +NDC,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet. 111 . . S RXNORM=$$GETRXN(NDC) 112 . . S SRCIEN=$$FIND1^DIC(176.003,,,"RXNORM","B") 113 . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6) 114 . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7) 115 . ; 116 . E S (RXNORM,RXNNAME,RXNVER)="" 117 . ; End if/else block 118 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM 119 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME 120 . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER 121 . ; --- End RxNorm section 122 . ; 123 . ; Brand name is 52 field 6.5 124 . S @MAP@("MEDBRANDNAMETEXT")=$$GET1^DIQ(52,RXIEN,6.5) 125 . ; 126 . ; Next I need Med Form (tab, cap etc), strength (250mg) 127 . ; concentration for liquids (250mg/mL) 128 . ; Since IHS does not have any of the new calls that 129 . ; Vista has, I will be doing a crosswalk: 130 . ; File 52, field 6 is Drug IEN in file 50 131 . ; File 50, field 22 is VA Product IEN in file 50.68 132 . ; In file 50.68, I will get the following: 133 . ; -- 1: Dosage Form 134 . ; -- 2: Strength 135 . ; -- 3: Units 136 . ; -- 8: Dispense Units 137 . ; -- Conc is 2 concatenated with 3 138 . ; 139 . ; *** If Drug is not matched to NDF, then VA Product will be "" *** 140 . ; 141 . N MEDIEN S MEDIEN=$$GET1^DIQ(52,RXIEN,6,"I") ; Drug IEN in 50 142 . N VAPROD S VAPROD=$$GET1^DIQ(50,MEDIEN,22,"I") ; VA Product in file 50.68 143 . I +VAPROD D 144 . . S @MAP@("MEDSTRENGTHVALUE")=$$GET1^DIQ(50.68,VAPROD,2) 145 . . S @MAP@("MEDSTRENGTHUNIT")=$$GET1^DIQ(50.68,VAPROD,3) 146 . . S @MAP@("MEDFORMTEXT")=$$GET1^DIQ(50.68,VAPROD,1) 147 . . S @MAP@("MEDCONCVALUE")=@MAP@("MEDSTRENGTHVALUE") 148 . . S @MAP@("MEDCONCUNIT")=@MAP@("MEDSTRENGTHUNIT") 149 . E D 150 . . S @MAP@("MEDSTRENGTHVALUE")="" 151 . . S @MAP@("MEDSTRENGTHUNIT")="" 152 . . S @MAP@("MEDFORMTEXT")="" 153 . . S @MAP@("MEDCONCVALUE")="" 154 . . S @MAP@("MEDCONCUNIT")="" 155 . ; End Strengh/Conc stuff 156 . ; 157 . ; Quantity is in the prescription, field 7 158 . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52,RXIEN,7) 159 . ; Dispense unit is in the drug file, field 14.5 160 . S @MAP@("MEDQUANTITYUNIT")=$$GET1^DIQ(50,MEDIEN,14.5) 161 . ; 162 . ; --- START OF DIRECTIONS --- 163 . ; Sig data not in any API :-( Oh yes, you can get the whole thing, but... 164 . ; we want the components. 165 . ; It's in multiple 113 in the Prescription File (52) 166 . ; #.01 DOSAGE ORDERED [1F] "20" 167 . ; #1 DISPENSE UNITS PER DOSE [2N] "1" 168 . ; #2 UNITS [3P:50.607] "MG" 169 . ; #3 NOUN [4F] "TABLET" 170 . ; #4 DURATION [5F] "10D" 171 . ; #5 CONJUNCTION [6S] "AND" 172 . ; #6 ROUTE [7P:51.2] "ORAL" 173 . ; #7 SCHEDULE [8F] "BID" 174 . ; #8 VERB [9F] "TAKE" 175 . ; 176 . ; Will use GETS^DIQ to get fields. 177 . ; Data comes out like this: 178 . ; SAMINS(52.0113,"1,23,",.01)=20 179 . ; SAMINS(52.0113,"1,23,",1)=1 180 . ; SAMINS(52.0113,"1,23,",2)="MG" 181 . ; SAMINS(52.0113,"1,23,",3)="TABLET" 182 . ; SAMINS(52.0113,"1,23,",4)="5D" 183 . ; SAMINS(52.0113,"1,23,",5)="THEN" 184 . ; 185 . N RAWDATA 186 . D GETS^DIQ(52,RXIEN,"113*",,"RAWDATA","DIERR") 187 . D:$D(DIERR) ^%ZTER ; Log if there's an error in retrieving sig field 188 . ; none the less, continue; some parts are retrievable. 189 . N FMSIG M FMSIG=RAWDATA(52.0113) ; Merge into subfile... 190 . K RAWDATA 191 . N FMSIGNUM S FMSIGNUM="" ; Sigline number in fileman. 192 . ; FMSIGNUM gets outputted as "IEN,RXIEN,". 193 . ; DIRCNT is the proper Sigline numer. 194 . ; SIGDATA is the simplfied array. 195 . F S FMSIGNUM=$O(FMSIG(FMSIGNUM)) Q:FMSIGNUM="" D 196 . . N DIRCNT S DIRCNT=$P(FMSIGNUM,",") 197 . . N SIGDATA M SIGDATA=FMSIG(FMSIGNUM) 198 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components. 199 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05. 200 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$G(SIGDATA(8)) 201 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$G(SIGDATA(.01)) 202 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=$G(SIGDATA(2)) 203 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient 204 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient 205 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient 206 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$G(SIGDATA(6)) 207 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$G(SIGDATA(7)) 208 . . ; Invervals... again another call. 209 . . ; In the wisdom of the original programmers, the schedule is a free text field 210 . . ; However, it gets translated by a call to the administration schedule file 211 . . ; to see if that schedule exists. 212 . . ; That's the same thing I am going to do. 213 . . ; Search B index of 51.1 (Admin Schedule) with schedule 214 . . ; First, remove "PRN" if it exists (don't ask, that's how the file 215 . . ; works; I wouldn't do it that way). 216 . . N SCHNOPRN S SCHNOPRN=$G(SIGDATA(7)) 217 . . I SCHNOPRN["PRN" S SCHNOPRN=$E(SCHNOPRN,1,$F(SCHNOPRN,"PRN")-5) 218 . . ; Super call below: 219 . . ; 1=File 51.1 3=Field 2 (Frequency in Minutes) 220 . . ; 4=Packed format, Exact Match 5=Lookup Value 221 . . ; 6=# of entries to return 7=Index 10=Return Array 222 . . ; 223 . . ; I do not account for the fact that two schedules can be 224 . . ; spelled identically (ie duplicate entry). In that case, 225 . . ; I get the first. That's just a bad pharmacy pkg maintainer. 226 . . N C0C515 227 . . D FIND^DIC(51.1,,"@;2","PX",SCHNOPRN,1,"B",,,"C0C515") 228 . . N INTERVAL S INTERVAL="" ; Default 229 . . ; If there are entries found, get it 230 . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2) 231 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL 232 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute" 233 . . ; Duration is 10M minutes, 10H hours, 10D for Days 234 . . ; 10W for weeks, 10L for months. I smell $Select 235 . . ; But we don't need to do that if there isn't a duration 236 . . I +$G(SIGDATA(4)) D 237 . . . N DURUNIT S DURUNIT=$E(SIGDATA(4),$L(SIGDATA(4))) ; get last char 238 . . . N DURTXT S DURTXT=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"Days") 239 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=+SIGDATA(4) 240 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=DURTXT 241 . . E D 242 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")="" 243 . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")="" 244 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$G(SIGDATA(4))["PRN" 245 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" ; when avail 246 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")="" 247 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")="" 248 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")="" 249 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")="" 250 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")="" 251 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")="" 252 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; not stored 253 . . ; Another confusing line; I am pretty bad: 254 . . ; If there is another entry in the FMSIG array (i.e. another line 255 . . ; in the sig), set the direction count indicator. 256 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")="" ; Default 257 . . S:+$O(FMSIG(FMSIGNUM)) @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRCNT 258 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$G(SIGDATA(5)) 259 . ; 260 . ; --- END OF DIRECTIONS --- 261 . ; 262 . ; Med instructions is a WP field, thus the acrobatics 263 . ; Notice buffer overflow protection set at 10,000 chars 264 . ; -- 1. Med Patient Instructions 265 . N MEDPTIN1 S MEDPTIN1=$$GET1^DIQ(52,RXIEN,115,,"MEDPTIN1") 266 . N MEDPTIN2,J S (MEDPTIN2,J)="" 267 . I $L(MEDPTIN1) F S J=$O(@MEDPTIN1@(J)) Q:J="" Q:$L(MEDPTIN2)>10000 S MEDPTIN2=MEDPTIN2_@MEDPTIN1@(J)_" " 268 . S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2 269 . K J 270 . ; -- 2. Med Provider Instructions 271 . N MEDPVIN1 S MEDPVIN1=$$GET1^DIQ(52,RXIEN,39,,"MEDPVIN1") 272 . N MEDPVIN2,J S (MEDPVIN2,J)="" 273 . I $L(MEDPVIN1) F S J=$O(@MEDPVIN1@(J)) Q:J="" Q:$L(MEDPVIN2)>10000 S MEDPVIN2=MEDPVIN2_@MEDPVIN1@(J)_" " 274 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MEDPVIN2 275 . ; 276 . ; Remaining refills 277 . S @MAP@("MEDRFNO")=$P(MEDS(MEDCNT),U,6) 278 . ; ------ END OF MAPPING 279 . ; 280 . ; ------ BEGIN XML INSERTION 281 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED")) 282 . K @RESULT 283 . D MAP^C0CXPATH(MINXML,MAP,RESULT) 284 . ; D PARY^C0CXPATH(RESULT) 285 . ; MAPPING DIRECTIONS 286 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 287 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 288 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 289 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions") 290 . ; N MDZ1,MDZNA 291 . N DIRCNT S DIRCNT="" 292 . I +$O(@MAP@("M","DIRECTIONS",DIRCNT)) D ; IF THERE ARE DIRCTIONS 293 . . F DIRCNT=$O(@MAP@("M","DIRECTIONS",DIRCNT)) D ; FOR EACH DIRECTION 294 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",DIRCNT)) 295 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2) 296 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication") 297 . D:MEDCNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 298 . D:MEDCNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 299 N MEDTMP,MEDI 300 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 301 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 302 . W "MEDICATION MISSING ",! 303 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 304 Q 305 ; 306 306 GETRXN(NDC) ; Extrinsic Function; PUBLIC; NDC to RxNorm 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 307 ;; Get RxNorm Concept Number for a Given NDC 308 ; 309 S NDC=$TR(NDC,"-") ; Remove dashes 310 N RXNORM,C0CZRXN,DIERR 311 D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR") 312 I $D(DIERR) D ^%ZTER BREAK 313 S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries 314 N I S I=0 315 F S I=$O(C0CZRXN("DILIST",I)) Q:I="" S RXNORM(I)=$P(C0CZRXN("DILIST",I,0),U,2) 316 ; At this point, RxNorm(0) is # of entries; RxNorm(1...) are the entries 317 ; If RxNorm(0) is 1, then we only have one entry, and that's it. 318 I RXNORM(0)=1 QUIT RXNORM(1) ; RETURN RXNORM(1) 319 ; Otherwise, we need to find out which one is the semantic 320 ; clinical drug. I built an index on 176.001 (RxNorm Concepts) 321 ; for that purpose. 322 I RXNORM(0)>1 D 323 . S I=0 324 . F S I=$O(RXNORM(I)) Q:I="" D Q:$G(RXNORM) 325 . . N RXNIEN S RXNIEN=$$FIND1^DIC(176.001,,,RXNORM(I),"SCD") 326 . . I +$G(RXNIEN)=0 QUIT ; try the next entry... 327 . . E S RXNORM=RXNORM(I) QUIT ; We found the right code 328 QUIT +$G(RXNORM) ; RETURN RXNORM; if we couldn't find a clnical drug, return with 0 329
Note:
See TracChangeset
for help on using the changeset viewer.
