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