- Timestamp:
- Apr 27, 2016, 7:02:22 PM (9 years ago)
- Location:
- ccr/trunk/rxnorm
- Files:
-
- 3 added
- 3 edited
-
tags/2.5 (added)
-
tags/2.5/RXNORM_FOR_VISTA_2P5.KID (added)
-
tags/2.5/ReleaseNotes.txt (added)
-
trunk/routines/C0CRXNAD.m (modified) (1 diff)
-
trunk/routines/C0CRXNLK.m (modified) (21 diffs)
-
trunk/routines/C0CRXNRD.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/rxnorm/trunk/routines/C0CRXNAD.m
r1642 r1730 1 C0CRXNAD 2 ;;2.3;RXNORM FOR VISTA;;Jul 22, 2014;Build 10 3 4 5 6 ADDDRUG(RXN,NDC,BARCODE) 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 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 EX 1 C0CRXNAD ; VEN/SMH - Add a drug to VISTA from RxNorm;2013-04-19 5:39 PM 2 ;;2.5;RXNORM FOR VISTA;;Apr 27, 2016;Build 17 3 ; (C) 2013 Sam Habiel 4 ; Proprietary Code. Don't use if license terms aren't supplied. 5 ; 6 ADDDRUG(RXN,NDC,BARCODE) ; Public Proc; Add Drug to Drug File 7 ; Input: RXN - RxNorm Semantic Clinical Drug CUI by Value. Required. 8 ; Input: NDC - Drug NDC by Value. Optional. Pass in 11 digit format without dashes. 9 ; Input: BARCODE - Wand Barcode. Optional. Pass exactly as wand reads minus control characters. 10 ; Output: Internal Entry Number 11 ; 12 ; Prelim Checks 13 I '$G(RXN) S $EC=",U1," ; Required 14 I $L($G(NDC)),$L(NDC)'=11 S $EC=",U1," 15 ; 16 N PSSZ S PSSZ=1 ; Needed for the drug file to let me in! 17 ; 18 ; If RXN refers to a brand drug, get the generic instead. 19 I $$ISBRAND^C0CRXNLK(RXN) S RXN=$$BR2GEN^C0CRXNLK(RXN) 20 W !,"(debug) RxNorm is "_RXN,! 21 ; 22 ; Get first VUID for this RxNorm drug 23 N VUID S VUID=+$$RXN2VUI^C0CRXNLK(RXN) 24 Q:'VUID 25 W "(debug) VUID for RxNorm CUI "_RXN_" is "_VUID,! 26 ; 27 ; IEN in 50.68 28 N C0XVUID ; For Searching Compound Index 29 S C0XVUID(1)=VUID 30 S C0XVUID(2)=1 31 N F5068IEN S F5068IEN=$$FIND1^DIC(50.68,"","XQ",.C0XVUID,"AMASTERVUID") 32 Q:'F5068IEN 33 W "F 50.68 IEN (debug): "_F5068IEN,! 34 ; 35 ; FDA Array 36 N C0XFDA 37 ; 38 ; Name, shortened 39 S C0XFDA(50,"+1,",.01)=$E($$GET1^DIQ(50.68,F5068IEN,.01),1,40) 40 ; 41 ; File BarCode as a Synonym for BCMA 42 I $L($G(BARCODE)) D 43 . S C0XFDA(50.1,"+2,+1,",.01)=BARCODE 44 . S C0XFDA(50.1,"+2,+1,",1)="Q" 45 ; 46 ; Brand Names 47 N BNS S BNS=$$RXN2BNS^C0CRXNLK(RXN) ; Brands 48 I $L(BNS) N I F I=1:1:$L(BNS,U) D 49 . N IENS S IENS=I+2 50 . S C0XFDA(50.1,"+"_IENS_",+1,",.01)=$$UP^XLFSTR($E($P(BNS,U,I),1,40)) 51 . S C0XFDA(50.1,"+"_IENS_",+1,",1)="T" 52 ; 53 ; NDC (string) 54 I $G(NDC) S C0XFDA(50,"+1,",31)=$E(NDC,1,5)_"-"_$E(NDC,6,9)_"-"_$E(NDC,10,11) 55 ; 56 ; Dispense Unit (string) 57 S C0XFDA(50,"+1,",14.5)=$$GET1^DIQ(50.68,F5068IEN,"VA DISPENSE UNIT") 58 ; 59 ; National Drug File Entry (pointer to 50.6) 60 S C0XFDA(50,"+1,",20)="`"_$$GET1^DIQ(50.68,F5068IEN,"VA GENERIC NAME","I") 61 ; 62 ; VA Product Name (string) 63 S C0XFDA(50,"+1,",21)=$E($$GET1^DIQ(50.68,F5068IEN,.01),1,70) 64 ; 65 ; PSNDF VA PRODUCT NAME ENTRY (pointer to 50.68) 66 S C0XFDA(50,"+1,",22)="`"_F5068IEN 67 ; 68 ; DEA, SPECIAL HDLG (string) 69 D ; From ^PSNMRG 70 . N CS S CS=$$GET1^DIQ(50.68,F5068IEN,"CS FEDERAL SCHEDULE","I") 71 . S CS=$S(CS?1(1"2n",1"3n"):+CS_"C",+CS=2!(+CS=3)&(CS'["C"):+CS_"A",1:CS) 72 . S C0XFDA(50,"+1,",3)=CS 73 ; 74 ; NATIONAL DRUG CLASS (pointer to 50.605) (triggers VA Classification field) 75 S C0XFDA(50,"+1,",25)="`"_$$GET1^DIQ(50.68,F5068IEN,"PRIMARY VA DRUG CLASS","I") 76 ; 77 ; Right Now, I don't file the following which ^PSNMRG does (cuz I don't need them) 78 ; - Package Size (derived from NDC/UPN file) 79 ; - Package Type (ditto) 80 ; - CMOP ID (from $$PROD2^PSNAPIS) 81 ; - National Formulary Indicator (from 50.68) 82 ; 83 ; Next Step is to kill Old OI if Dosage Form doesn't match 84 ; Won't do that here as it's assumed any drugs that's added is new. 85 ; This happens at ^PSNPSS 86 ; 87 ; Now add drug to drug file, as we need the IEN for the dosages call. 88 N C0XERR,C0XIEN 89 D UPDATE^DIE("E","C0XFDA","C0XIEN","C0XERR") 90 S:$D(C0XERR) $EC=",U1," 91 ; 92 ; Next Step: Kill off old doses and add new ones. 93 D EN2^PSSUTIL(C0XIEN(1)) 94 ; 95 ; Mark uses for the Drug; use the undocumented Silent call in PSSGIU 96 N PSIUDA,PSIUX ; Expected Input variables 97 S PSIUDA=C0XIEN(1),PSIUX="O^Outpatient Pharmacy" D ENS^PSSGIU 98 S PSIUDA=C0XIEN(1),PSIUX="U^Unit Dose" D ENS^PSSGIU 99 S PSIUDA=C0XIEN(1),PSIUX="X^Non-VA Med" D ENS^PSSGIU 100 ; 101 ; Get VA Generic text and VA Product pointer for Orderable Item creation plus dosage form information 102 N VAGENP S VAGENP=$P(^PSDRUG(C0XIEN(1),"ND"),U) ; VA Generic Pointer 103 N VAGEN S VAGEN=$$VAGN^PSNAPIS(VAGENP) ; VA Generic Full name 104 N VAPRODP S VAPRODP=$P(^PSDRUG(C0XIEN(1),"ND"),U,3) ; VA Product Pointer 105 N DOSAGE S DOSAGE=$$PSJDF^PSNAPIS(0,VAPRODP) ; IEN of dose form in 50.606 ^ Text 106 N DOSEPTR S DOSEPTR=$P(DOSAGE,U) ; ditto 107 N DOSEFORM S DOSEFORM=$P(DOSAGE,U,2) ;ditto 108 ; 109 ; Get the (possibly new) Orderable Item Text 110 N VAG40 S VAG40=$E(VAGEN,1,40) ; Max length of .01 field 111 ; 112 ; See if there is an existing orderable item already. If so, populate the Pharmacy Orderable item on drug file. 113 N OI S OI=$O(^PS(50.7,"ADF",VAG40,DOSEPTR,"")) 114 ; 115 ; Otherwise, add a new one. (See MCHAN+12^PSSPOIMN) 116 I 'OI D 117 . N C0XFDA,C0XERR 118 . S C0XFDA(50.7,"+1,",.01)=VAG40 119 . S C0XFDA(50.7,"+1,",.02)=DOSEPTR 120 . D UPDATE^DIE("",$NA(C0XFDA),$NA(OI),$NA(C0XERR)) 121 . I $D(C0XERR) S $EC=",U1," 122 . S OI=OI(1) ; For ease of use... 123 . ; Next two statements: See FIN^PSSPOIM1 and MF^PSSDEE. 124 . D EN^PSSPOIDT(OI) ; Update Indexes; activations, etc. 125 . D EN2^PSSHL1(OI,"MUP") ; Send HL7 message to CPRS 126 ; 127 ; Finally, add the orderable Item to the drug file. 128 N C0XFDA,C0XERR S C0XFDA(50,C0XIEN(1)_",",2.1)=OI ; Orderable Item 129 D FILE^DIE("",$NA(C0XFDA),$NA(C0XERR)) 130 S:$D(C0XERR) $EC=",U1," 131 ; 132 EX QUIT C0XIEN(1) -
ccr/trunk/rxnorm/trunk/routines/C0CRXNLK.m
r1665 r1730 1 1 C0CRXNLK ; VEN/SMH - RxNorm Lookup Utilities ;2014-07-22 2:27 PM 2 ;;2. 3;RXNORM FOR VISTA;;Jul 22, 2014;Build 163 ;(c) Sam Habiel 201 32 ;;2.5;RXNORM FOR VISTA;;Apr 27, 2016;Build 16 3 ;(c) Sam Habiel 2016 4 4 ; See accompanying license. Don't use otherwise. 5 5 ; … … 7 7 N DIQUIET S DIQUIET=1 8 8 D DT^DICRW 9 D EN^ XTMUNIT($T(+0),1)9 D EN^%ut($T(+0),2) 10 10 QUIT 11 11 ; … … 22 22 Q ^(IEN) 23 23 ; 24 GCN2RXNT ; @TEST -Test Get RxNorm CUI using GCN24 GCN2RXNT ; @TEST Test Get RxNorm CUI using GCN 25 25 Q:'$D(^C0CRXN(176.001,"STC","NDDF")) 26 26 N L F L=1:1 N LN S LN=$T(GCN2RXND+L) Q:LN["<<END>>" Q:LN="" D 27 27 . N GCN S GCN=$P(LN,";",3) 28 28 . N RXN S RXN=$P(LN,";",4) 29 . D CHKEQ^ XTMUNIT($$GCN2RXN(GCN),RXN,"Translation from GCN to RXCUI failed")29 . D CHKEQ^%ut($$GCN2RXN(GCN),RXN,"Translation from GCN to RXCUI failed") 30 30 QUIT 31 31 ; 32 32 GCN2RXND ; @DATA - Data for Tests ;;GCN;EXPECTED RXNCUI 33 ;;16033;99163234 33 ;;8208;310429 35 34 ;;1275;628953 … … 49 48 Q GCNS 50 49 ; 51 RXN2GCNT ; @TEST -Test Get GCN from RXNCUI50 RXN2GCNT ; @TEST Test Get GCN from RXNCUI 52 51 Q:'$D(^C0CRXN(176.001,"STX","NDDF")) 53 52 N L F L=1:1 N LN S LN=$T(RXN2GCND+L) Q:LN["<<END>>" Q:LN="" D 54 53 . N RXN S RXN=$P(LN,";",3) 55 54 . N GCN S GCN=$P(LN,";",4) 56 . D CHKEQ^ XTMUNIT($$RXN2GCN(RXN),GCN,"Translation from RXCUI to GCN failed")55 . D CHKEQ^%ut($$RXN2GCN(RXN),GCN,"Translation from RXCUI to GCN failed") 57 56 QUIT 58 57 ; … … 60 59 RXN2GCND ; @DATA - Data for Tests ;;RXNORM CUI;Expected GCN; Human Readable Drug name for dear reader 61 60 ;;998689;5145;Acetabulol 200mg tab 62 ;;745679; 5037;Albuterol Inhaler61 ;;745679;28090;Albuterol Inhaler 63 62 ;;197320;2536;Allopurinol 300mg tab 64 ;;993691; 3948^46236;Bupropion 75mg tab63 ;;993691;46236;Bupropion 75mg tab 65 64 ;;197591;3768;Diazepam 5mg tab 66 65 ;;<<END>> … … 79 78 Q C0PVUID 80 79 ; 81 RXN2VUIT ; @TEST -Get VUIDs given RxNorm values80 RXN2VUIT ; @TEST Get VUIDs given RxNorm values 82 81 N L F L=1:1 N LN S LN=$T(RXN2VUID+L) Q:LN["<<END>>" Q:LN="" D 83 82 . N RXN S RXN=$P(LN,";",3) 84 83 . N VUIDS S VUIDS=$P(LN,";",4) 85 . D CHKEQ^ XTMUNIT($P($$RXN2VUI(RXN),U),$P(VUIDS,U),"Translation from RXNCUI to VUID failed")84 . D CHKEQ^%ut($P($$RXN2VUI(RXN),U),$P(VUIDS,U),"Translation from RXNCUI to VUID failed") 86 85 QUIT 87 86 ; 88 87 RXN2VUID ; @DATA - Data items for previous test 89 ;;991632;400645590 88 ;;310429;4002369^4013941 91 ;;628953;40008 74^4000856^4013966^4015798^401579989 ;;628953;4000856^4013966^4015798^4015799 92 90 ;;197604;4003335^4015937 93 ;;884173;4002469^4013919 91 ;;884173;4002469^4013919^4032795 94 92 ;;<<END>> 95 93 ; … … 105 103 Q O 106 104 ; 107 VUI2VAPT ; @TEST -Get VA Product IEN from VUID105 VUI2VAPT ; @TEST Get VA Product IEN from VUID 108 106 N L F L=1:1 N LN S LN=$T(VUI2VAPD+L) Q:LN["<<END>>" Q:LN="" D 109 107 . N VUID S VUID=$P(LN,";",3) 110 108 . N VAP S VAP=$P(LN,";",4) 111 . D CHKEQ^ XTMUNIT($$VUI2VAP(VUID),VAP,"Translation from VUID to VA PRODUCT failed")109 . D CHKEQ^%ut($$VUI2VAP(VUID),VAP,"Translation from VUID to VA PRODUCT failed") 112 110 QUIT 113 111 ; … … 166 164 N IEN S IEN=$O(^C0CRXN(176.001,"STC","NDDF","IN",BASE,"")) Q ^(IEN) 167 165 ; 168 FDI2RXNT ; @TEST -Test Get RxNorm CUI for FDB Ingredient/Base166 FDI2RXNT ; @TEST Test Get RxNorm CUI for FDB Ingredient/Base 169 167 Q:'$D(^C0CRXN(176.001,"STC","NDDF")) 170 D CHKEQ^ XTMUNIT($$FDI2RXN(14739),1362160,"$$FDI2RXN failed")168 D CHKEQ^%ut($$FDI2RXN(14739),1362160,"$$FDI2RXN failed") 171 169 QUIT 172 170 ; … … 177 175 ; Input: RXNCUI By Value 178 176 ; Output: VUID 179 N IEN S IEN=$O(^C0CRXN(176.001,"STX","VANDF","IN",RXNCUI,"")) Q ^(IEN) 180 ; 181 RXN2VINT ; @TEST - Test Get VUID Ingredient for RxNorm CUI 182 D CHKEQ^XTMUNIT($$RXN2VIN(1366467),4031768,"$$RXN2VIN failed") 177 N IEN S IEN=$O(^C0CRXN(176.001,"STX","VANDF","IN",RXNCUI,"")) 178 I IEN Q ^(IEN) 179 E Q "" 180 ; 181 RXN2VINT ; @TEST Test Get VUID Ingredient for RxNorm CUI 182 D CHKEQ^%ut($$RXN2VIN(1366467),4031768,"$$RXN2VIN failed") 183 183 QUIT 184 184 ; … … 192 192 Q C0PIEN_"^"_C0P01 193 193 ; 194 VIN2VAGT ; @TEST -Test Get VA Generic for VUID Ingredient195 D CHKEQ^ XTMUNIT(+$$VIN2VAG(4023636),2832,"$$VIN2VAG failed")194 VIN2VAGT ; @TEST Test Get VA Generic for VUID Ingredient 195 D CHKEQ^%ut(+$$VIN2VAG(4023636),2832,"$$VIN2VAG failed") 196 196 QUIT 197 197 ; … … 218 218 Q $$VIN2DIN($$RXN2VIN($$FDI2RXN(BASE))) 219 219 ; 220 VUI2RXN(VUID) ; $$ Public - Get RXNCUI for VUID (any VUID type) 221 ; Input: VUID By Value 222 ; Output: RXNCUIs delimited by ^ 223 ; Get all entries whose code is the VUID and are in the VA NDF which are clinical drugs 224 D FIND^DIC(176.001,,"@;.01","PQX",VUID,,"CODE","I $P(^(0),U,12,13)=""VANDF^CD""") 225 ; Deserialise it into a single string 226 ; ^TMP("DILIST",4844,0)="1^*^0^" 227 ; ^TMP("DILIST",4844,0,"MAP")="IEN^.01" 228 ; ^TMP("DILIST",4844,1,0)="1006351^1364462" 229 N RXNS S RXNS="" 230 N I F I=0:0 S I=$O(^TMP("DILIST",$J,I)) Q:'I S RXNS=RXNS_$P(^(I,0),U,2)_U 231 S RXNS=$E(RXNS,1,$L(RXNS)-1) 232 QUIT RXNS 220 VUI2RXN(VUID,TTY) ; $$ Public Stephanie's Unified VUID searcher. Get RXNCUI given VUID 221 ;GIVEN A VUID IN ONE OF SEVERAL FILES RETURN THE ASSOCIATED RXNORM CODE IN 176.001 222 ; TTY="IN", "CD", or "PT" 223 ; IN = DRUG INGRIDENT FILE & VA GENERIC file 224 ; CD = VA PRODUCT FILE 225 ; PT = VA DRUG CLASS 226 ; 227 ; SAB="VANDF" 228 ; CODE=VUID 229 ; 230 I $O(^C0CRXN(176.001,"STC","VANDF",TTY,VUID,"")) Q ^($O(^(""))) 231 Q "" 232 ; 233 VUI2RXNT ; @TEST VUID to RxNorm CUI tests 234 D CHKEQ^%ut($$VUI2RXN(4010151,"CD"),314231) 235 D CHKEQ^%ut($$VUI2RXN(4020940,"IN"),16681) 236 D CHKEQ^%ut($$VUI2RXN(4021568,"PT"),883) 237 D CHKEQ^%ut($$VUI2RXN(1234234,"CD"),"") 238 QUIT 233 239 ; 234 240 VUI2GCN(VUID) ; $$ Public - Get GCNs for a given VUID (any VUID type) … … 236 242 ; Output: GCNs delimited by ^ 237 243 ; TODO: Unit Test 238 N RXNS S RXNS=$$VUI2RXN(VUID )244 N RXNS S RXNS=$$VUI2RXN(VUID,"AB") 239 245 Q:RXNS="" "" ; VUID not a drug or ingredient (can be food) 240 246 N GCNS S GCNS="" … … 251 257 N VUID S VUID=+^PSNDF(50.68,VAP,"VUID") ; Get VUID 252 258 I 'VUID S $EC=",U1," ; Must exist 253 Q $$VUI2RXN(VUID )259 Q $$VUI2RXN(VUID,"AB") 254 260 ; 255 261 MED2SCDN(DA) ; $$ Public - Medication to Semantic Clinical Drug Name … … 258 264 N RXNCUI S RXNCUI=$$MED2RXN(DA) 259 265 Q:'RXNCUI "" 266 Q $$SCDNAME(RXNCUI) 267 ; 268 SCDNAME(RXNCUI) ; $$ Public - Semantic Clinical Drug Name for RxNorm CUI 260 269 N IEN S IEN=$O(^C0CRXN(176.001,"STC","RXNORM","SCD",RXNCUI,"")) ; Let's try generic drug 261 270 I 'IEN S IEN=$O(^C0CRXN(176.001,"STC","RXNORM","SBD",RXNCUI,"")) ; Let's try non-bioequivalent Brands then … … 265 274 Q $P(^C0CRXN(176.001,IEN,0),U,15) 266 275 ; 276 ANYNAME(RXNCUI) ; $$ Public - Get the RxNorm name, no matter what it is 277 N RESULT S RESULT="" 278 N TTY S TTY="" 279 F S TTY=$O(^C0CRXN(176.001,"STC","RXNORM",TTY)) Q:TTY="" D Q:RESULT]"" 280 . N IEN S IEN=$O(^C0CRXN(176.001,"STC","RXNORM",TTY,RXNCUI,"")) 281 . Q:'IEN 282 . S RESULT=$P(^C0CRXN(176.001,IEN,0),U,15) 283 QUIT RESULT 284 ; 267 285 RXN2NDI(RXNCUI) ; $$ Public - Get NDDF Ingredient for RXNCUI 268 286 ; Input: RXNCUI By Value … … 276 294 ; Output: NDDF Base code 277 295 ; TODO:Not tested... 278 Q $$RXN2NDI($$VUI2RXN(VUID ))296 Q $$RXN2NDI($$VUI2RXN(VUID,"IN")) 279 297 ; 280 298 ; --- … … 287 305 N IEN S IEN=$O(^C0CRXN(176.002,"ASAA","RXNORM","NDC",NDC,"")) Q ^(IEN) 288 306 ; 289 NDC2RXNT ; @TEST -Test Get RxCUI given the NDC & Get RxCUI given the 50.67 NDC290 D CHKEQ^ XTMUNIT($$NDC2RXN("30142-0917-71"),198439,"$$NDC2RXN failed")291 D CHKEQ^ XTMUNIT($$NDC2RXN2("000031868518","VANDF"),996520,"$$NDC2RXN2 failed")307 NDC2RXNT ; @TEST Test Get RxCUI given the NDC & Get RxCUI given the 50.67 NDC 308 D CHKEQ^%ut($$NDC2RXN("30142-0917-71"),198439,"$$NDC2RXN failed") 309 D CHKEQ^%ut($$NDC2RXN2("000031868518","VANDF"),996520,"$$NDC2RXN2 failed") 292 310 QUIT 293 311 ; … … 304 322 ; Output: 0 or 1 305 323 Q ''$D(^C0CRXN(176.001,"STC","RXNORM","SBD",RXN)) 306 ISBRANDT ; @TEST -Test Is this RxCUI for a brand drug?307 D CHKEQ^ XTMUNIT($$ISBRAND(205535),1,"$$ISBRAND failed") ; Brand Prozac308 D CHKEQ^ XTMUNIT($$ISBRAND(310384),0,"$$ISBRAND failed") ; Generic Fluoxetine324 ISBRANDT ; @TEST Test Is this RxCUI for a brand drug? 325 D CHKEQ^%ut($$ISBRAND(205535),1,"$$ISBRAND failed") ; Brand Prozac 326 D CHKEQ^%ut($$ISBRAND(310384),0,"$$ISBRAND failed") ; Generic Fluoxetine 309 327 QUIT 310 328 ; … … 315 333 ; Output: RxCUI of Generic 316 334 Q $O(^C0CRXN(176.005,"B",RXN,"has_tradename","")) 317 BR2GENT ; @TEST -Test Convert Brand RxCUI to Generic RxCUI (many to 1)318 D CHKEQ^ XTMUNIT($$BR2GEN(205535),310384,"$$BR2GEN failed")335 BR2GENT ; @TEST Test Convert Brand RxCUI to Generic RxCUI (many to 1) 336 D CHKEQ^%ut($$BR2GEN(205535),310384,"$$BR2GEN failed") 319 337 QUIT 320 338 ; … … 327 345 Q RTN 328 346 ; 329 GEN2BRT ; @TEST -Test Convert Generic RxCUI to Brand RxCUIs (1 to many).330 D CHKTF^ XTMUNIT($$GEN2BR(310384)[205535,"$$GEN2BR failed")347 GEN2BRT ; @TEST Test Convert Generic RxCUI to Brand RxCUIs (1 to many). 348 D CHKTF^%ut($$GEN2BR(310384)[205535,"$$GEN2BR failed") 331 349 QUIT 332 350 ; … … 345 363 . S BNS=BNS_$P(^C0CRXN(176.001,BNIEN,0),U,15)_U 346 364 QUIT $E(BNS,1,$L(BNS)-1) 347 RXN2BNST ; @TEST -Test Get all Brand Names associated with an RXN348 D CHKTF^ XTMUNIT($$RXN2BNS(205535)["Prozac","$$RXN2BNS failed")349 QUIT 350 ; 351 ; --- 352 ; 353 RXN2NDC(RXN) ; Get NDC codes for RxNorm code365 RXN2BNST ; @TEST Test Get all Brand Names associated with an RXN 366 D CHKTF^%ut($$RXN2BNS(205535)["Prozac","$$RXN2BNS failed") 367 QUIT 368 ; 369 ; --- 370 ; 371 RXN2NDC(RXN) ; $$ Public - Get NDC codes for RxNorm code 354 372 N NDCS S NDCS="" 355 373 N I F I=0:0 S I=$O(^C0CRXN(176.002,"ASAR","RXNORM","NDC",RXN,I)) Q:'I S NDCS=NDCS_^(I)_"^" 356 374 S $E(NDCS,$L(NDCS))="" 357 375 QUIT NDCS 358 RXN2NDCT ; @TEST - Test Get NDC codes for RxNorm code 359 D CHKTF^XTMUNIT($$RXN2NDC(197379)["^"_16714003309,"$$RXN2NDC failed") 360 QUIT 376 RXN2NDCT ; @TEST Test Get NDC codes for RxNorm code 377 D CHKTF^%ut($$RXN2NDC(197379)["^"_16714003309,"$$RXN2NDC failed") 378 QUIT 379 ; 380 LVUID(RXN) ; $$ Public - Locate VUID, given RxNorm. Iterative Search 381 ; ^C0CRXN(176.001,"STC","RXNORM","IN",46239,IEN 382 N TTY S TTY="" 383 N intermediateRxCUI 384 N finalVUID 385 i '$$EXIST(RXN) q "0^not found in RxNorm" 386 ; 387 F S TTY=$O(^C0CRXN(176.001,"STC","RXNORM",TTY)) Q:TTY="" D q:$g(intermediateRxCUI) q:$g(finalVUID) 388 . N IEN S IEN=$O(^C0CRXN(176.001,"STC","RXNORM",TTY,RXN,"")) 389 . I 'IEN quit ; s err="0^not found in RxNorm" quit 390 . ; W ^C0CRXN(176.001,IEN,0),! 391 . I TTY="BN" s intermediateRxCUI=$$BR2GEN(RXN) quit ; try searching with generic 392 . I TTY="IN"!(TTY="MIN") s finalVUID=$$RXN2VIN(RXN) quit ; match VUID 393 . I TTY="PIN" s intermediateRxCUI=$$formOf(RXN) quit ; try searching with ingredient 394 . I TTY="SCD" d 395 .. s finalVUID=$$RXN2VUI(RXN) 396 .. i finalVUID="" s finalVUID=$$containerOf(RXN) 397 .. I finalVUID="" s finalVUID=$$tradeName(RXN) 398 . I TTY="GPCK" d 399 .. s finalVUID=$$tradeName(RXN) 400 i $get(intermediateRxCUI) q $$LVUID(intermediateRxCUI) ; recurse 401 i $get(finalVUID) quit finalVUID 402 quit "0^no mapping found in RxNorm" 403 ; 404 formOf(RXN) ; RXN is form of result 405 q $o(^C0CRXN(176.005,"B",RXN,"has_form","")) 406 containerOf(RXN) ; loop through all contains and see if one hits it. 407 n container 408 n vuid s vuid="" 409 f container=0:0 s container=$o(^C0CRXN(176.005,"B",RXN,"contains",container)) q:'container d q:$g(vuid) 410 . s vuid=$$RXN2VUI(container) 411 quit vuid 412 tradeName(RXN) ; loop through all tradenames and see if there's a match 413 n vuid s vuid="" 414 n tncui f tncui=0:0 s tncui=$o(^C0CRXN(176.005,"B",RXN,"tradename_of",tncui)) q:'tncui d q:$g(vuid) 415 . s vuid=$$RXN2VUI(tncui) 416 quit vuid 417 ; 418 loopVUIDs ; [Public] Paste VUIDs to get the RxNorm Numbers 419 ; ZEXCEPT: DTIME 420 n rxn 421 f r rxn:$g(DTIME,300) q:rxn="" q:rxn=$c(4) d 422 . w "|" 423 . w $$LVUID(rxn),"|",$$ANYNAME(rxn),! 424 quit -
ccr/trunk/rxnorm/trunk/routines/C0CRXNRD.m
r1642 r1730 1 C0CRXNRD ; VEN/SMH - RxNorm Utilities: Routine to Read RxNorm files;2013-11-14 1:23 PM 2 ;;2.3;RXNORM FOR VISTA;;Jul 22, 2014;Build 10 3 ; (C) Sam Habiel 2013 4 ; See license for terms of use. 5 ; 6 W "No entry from top" Q 7 IMPORT(PATH,RESTRICTED) ; PUBLIC ENTRY POINT. Rest are private 8 I PATH="" QUIT 9 S RESTRICTED=$G(RESTRICTED,0) 10 S U="^" 11 N STARTTIME S STARTTIME=$P($H,",")*24*60*60+$P($H,",",2) 12 N SABS 13 D SAB(PATH,.SABS) ; Load restriction values into SAB. ; 176.006 14 D CONSO(PATH,.SABS,RESTRICTED),SAT(PATH,.SABS,RESTRICTED) ; 176.001,176.002 15 D STY(PATH),REL(PATH),DOC(PATH) ; 176.003-5 16 N ENDTIME S ENDTIME=$P($H,",")*24*60*60+$P($H,",",2) 17 W !,(ENDTIME-STARTTIME)/60_" minutes elapsed" 18 QUIT 19 ; 20 ; Everything is private from down on... 21 DELFILED(FN) ; Delete file data; PEP procedure; only for RxNorm files 22 ; FN is Filenumber passed by Value 23 QUIT:$E(FN,1,3)'=176 ; Quit if not RxNorm files 24 N ROOT S ROOT=$$ROOT^DILFD(FN,"",1) ; global root 25 N ZERO S ZERO=@ROOT@(0) ; Save zero node 26 S $P(ZERO,U,3,9999)="" ; Remove entry # and last edited 27 K @ROOT ; Kill the file -- so sad! 28 S @ROOT@(0)=ZERO ; It riseth again! 29 QUIT 30 GETLINES(PATH,FILENAME) ; Get number of lines in a file 31 N POP 32 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 33 Q:POP 34 U IO 35 N I,LINE 36 F I=1:1 R LINE:0 Q:$$STATUS^%ZISH 37 D CLOSE^%ZISH("FILE") 38 Q I-1 39 CONSO(PATH,SABS,RESTRICTED) ; Open and read concepts file: RXNCONSO.RRF 40 ; PATH ByVal, path of RxNorm files 41 ; SABS ByRef, arrays of SABS(SAB)=restriction level 42 ; RESTRICTED ByVal, include restricted sources. 1 for yes, 0 for no 43 I PATH="" QUIT 44 N FILENAME S FILENAME="RXNCONSO.RRF" 45 D DELFILED(176.001) ; delete data 46 N LINES S LINES=$$GETLINES(PATH,FILENAME) 47 N POP 48 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 49 IF POP D EN^DDIOL("Error reading file..., Please check...") G EX 50 N C0CCOUNT 51 F C0CCOUNT=1:1 D Q:$$STATUS^%ZISH 52 . U IO 53 . N LINE R LINE:0 54 . IF $$STATUS^%ZISH QUIT 55 . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000 56 . ; 57 . ; Deal with restriction level 58 . N SAB S SAB=$P(LINE,"|",12) 59 . I 'RESTRICTED,SABS(SAB) QUIT ; If not include restricted, and SABS(SAB) is not zero, quit 60 . ; 61 . ; Save data 62 . S ^C0CRXN(176.001,C0CCOUNT,0)=$TR(LINE,"|^","^|") 63 EX D CLOSE^%ZISH("FILE") 64 N DIK S DIK="^C0CRXN(176.001," D IXALL^DIK 65 QUIT 66 ; 67 ; 68 SAT(PATH,SABS,RESTRICTED) ; Open and read Concept and Atom attributes: RXNSAT.RRF 69 ; PATH ByVal, path of RxNorm files 70 ; SABS ByRef, arrays of SABS(SAB)=restriction level 71 ; RESTRICTED ByVal, include restricted sources. 1 for yes, 0 for no 72 I PATH="" QUIT 73 N FILENAME S FILENAME="RXNSAT.RRF" 74 D DELFILED(176.002) ; delete data 75 N LINES S LINES=$$GETLINES(PATH,FILENAME) 76 N POP 77 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 78 IF POP W "Error reading file..., Please check...",! G EX2 79 N C0CCOUNT F C0CCOUNT=1:1 Q:$$STATUS^%ZISH D 80 . U IO 81 . N LINE R LINE:0 82 . IF $$STATUS^%ZISH QUIT 83 . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000 84 . ; 85 . ; We switch around the fields .01 and .09 because the .01 isn't always present; where as .09 is required 86 . N RXCUI1,ATN9 87 . S RXCUI1=$P(LINE,"|",1) 88 . S ATN9=$P(LINE,"|",9) 89 . S $P(LINE,"|",1)=ATN9 90 . S $P(LINE,"|",9)=RXCUI1 91 . ; 92 . ; Deal with restricted sources 93 . N SAB S SAB=$P(LINE,"|",10) 94 . I 'RESTRICTED,SABS(SAB) QUIT ; If not include restricted, and SABS(SAB) is not zero, quit 95 . ; 96 . ; Save off 97 . S ^C0CRXN(176.002,C0CCOUNT,0)=$TR(LINE,"|^","^|") 98 EX2 D CLOSE^%ZISH("FILE") 99 N DIK S DIK="^C0CRXN(176.002," D IXALL^DIK 100 QUIT 101 ; 102 ; 103 SAB(PATH,SABS) ; Open the read RxNorm Sources file: RXNSAB.RRF 104 I PATH="" QUIT 105 N FILENAME S FILENAME="RXNSAB.RRF" 106 D DELFILED(176.003) ; delete data 107 N POP 108 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 109 IF POP W "Error reading file..., Please check...",! G EX3 110 N I F I=1:1 Q:$$STATUS^%ZISH D 111 . U IO 112 . N LINE R LINE:0 113 . IF $$STATUS^%ZISH QUIT 114 . U $P W I,! U IO ; Write I to the screen, then go back to reading the file 115 . ; Switch pieces 1 and 4 because 4 is always defined. Goes into .01 field. 116 . N VCUI S VCUI=$P(LINE,"|",1) 117 . N RSAB S RSAB=$P(LINE,"|",4) 118 . S $P(LINE,"|",1)=RSAB 119 . S $P(LINE,"|",4)=VCUI 120 . S ^C0CRXN(176.003,I,0)=$TR(LINE,"^|","|^") 121 EX3 D CLOSE^%ZISH("FILE") 122 N DIK S DIK="^C0CRXN(176.003," D IXALL^DIK 123 N C0CI F C0CI=0:0 S C0CI=$O(^C0CRXN(176.003,C0CI)) Q:'C0CI D 124 . S SABS($$GET1^DIQ(176.003,C0CI,.01))=$$GET1^DIQ(176.003,C0CI,"SRL") 125 QUIT 126 STY(PATH) ; Open and read RxNorm Semantic types file: RXNSTY.RRF 127 I PATH="" QUIT 128 N FILENAME S FILENAME="RXNSTY.RRF" 129 D DELFILED(176.004) ; delete data 130 N LINES S LINES=$$GETLINES(PATH,FILENAME) ; Get # of lines 131 N POP 132 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 133 IF POP W "Error reading file..., Please check...",! G EX4 134 N I F I=1:1 Q:$$STATUS^%ZISH D 135 . U IO 136 . N LINE R LINE:0 137 . IF $$STATUS^%ZISH QUIT 138 . I '(I#1000) U $P W I," of ",LINES," read ",! U IO ; update every 1000 139 . S ^C0CRXN(176.004,I,0)=$TR(LINE,"^|","|^") 140 EX4 D CLOSE^%ZISH("FILE") 141 N DIK S DIK="^C0CRXN(176.004," D IXALL^DIK 142 QUIT 143 ; 144 REL(PATH) ; Open and read RxNorm Relationships file: RXNREL.RRF 145 I PATH="" QUIT 146 N FILENAME S FILENAME="RXNREL.RRF" 147 D DELFILED(176.005) ; delete data 148 N LINES S LINES=$$GETLINES(PATH,FILENAME) ; Get # of lines 149 N POP 150 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 151 IF POP W "Error reading file..., Please check...",! G EX5 152 N I F I=1:1 Q:$$STATUS^%ZISH D 153 . U IO 154 . N LINE R LINE:0 155 . IF $$STATUS^%ZISH QUIT 156 . I '(I#1000) U $P W I," of ",LINES," read ",! U IO ; update every 1000 157 . ; swap RXCUI1 location with SAB b/c SAB is required so can be .01 field 158 . N RXCUI1 S RXCUI1=$P(LINE,"|",1) 159 . N SAB S SAB=$P(LINE,"|",11) 160 . S $P(LINE,"|",1)=SAB 161 . S $P(LINE,"|",11)=RXCUI1 162 . S ^C0CRXN(176.005,I,0)=$TR(LINE,"^|","|^") 163 EX5 D CLOSE^%ZISH("FILE") 164 N DIK S DIK="^C0CRXN(176.005," D IXALL^DIK 165 QUIT 166 DOC(PATH) ; Open the read RxNorm Abbreviation Documentation file: RXNDOC.RRF 167 I PATH="" QUIT 168 N FILENAME S FILENAME="RXNDOC.RRF" 169 D DELFILED(176.006) ; delete data 170 N LINES S LINES=$$GETLINES(PATH,FILENAME) ; Get # of lines 171 N POP 172 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 173 IF POP W "Error reading file..., Please check...",! G EX6 174 N I F I=1:1 Q:$$STATUS^%ZISH D 175 . U IO 176 . N LINE R LINE:0 177 . IF $$STATUS^%ZISH QUIT 178 . I '(I#1000) U $P W I," of ",LINES," read ",! U IO ; update every 1000 179 . S ^C0CRXN(176.006,I,0)=$TR(LINE,"^|","|^") 180 EX6 D CLOSE^%ZISH("FILE") 181 N DIK S DIK="^C0CRXN(176.006," D IXALL^DIK 182 QUIT 1 C0CRXNRD ; VEN/SMH - RxNorm Utilities: Routine to Read RxNorm files;2013-11-14 1:23 PM 2 ;;2.5;RXNORM FOR VISTA;;Apr 27, 2016;Build 10 3 ; (C) Sam Habiel 2016 4 ; See license for terms of use. 5 ; 6 W "No entry from top" Q 7 IMPORT(PATH,RESTRICTED) ; PUBLIC ENTRY POINT. Rest are private 8 I PATH="" QUIT 9 S RESTRICTED=$G(RESTRICTED,0) 10 S U="^" 11 N STARTTIME S STARTTIME=$P($H,",")*24*60*60+$P($H,",",2) 12 D SAB(PATH) ; Load restriction values into SAB. ; 176.006 13 JOB SAT^C0CRXNRD(PATH,RESTRICTED) ; 176.002 14 W "Jobbed off... "_$ZJOB_"." 15 D CONSO(PATH,RESTRICTED) ; 176.001,176.002 16 D STY(PATH),REL(PATH),DOC(PATH) ; 176.003-5 17 N ENDTIME S ENDTIME=$P($H,",")*24*60*60+$P($H,",",2) 18 W !,(ENDTIME-STARTTIME)/60_" minutes elapsed" 19 QUIT 20 ; 21 ; Everything is private from down on... 22 DELFILED(FN) ; Delete file data; PEP procedure; only for RxNorm files 23 ; FN is Filenumber passed by Value 24 QUIT:$E(FN,1,3)'=176 ; Quit if not RxNorm files 25 N ROOT S ROOT=$$ROOT^DILFD(FN,"",1) ; global root 26 N ZERO S ZERO=@ROOT@(0) ; Save zero node 27 S $P(ZERO,U,3,9999)="" ; Remove entry # and last edited 28 K @ROOT ; Kill the file -- so sad! 29 S @ROOT@(0)=ZERO ; It riseth again! 30 QUIT 31 GETLINES(PATH,FILENAME) ; Get number of lines in a file 32 N POP 33 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 34 Q:POP 35 U IO 36 N I,LINE 37 F I=1:1 R LINE:0 Q:$$STATUS^%ZISH 38 D CLOSE^%ZISH("FILE") 39 Q I-1 40 CONSO(PATH,RESTRICTED) ; Open and read concepts file: RXNCONSO.RRF 41 ; PATH ByVal, path of RxNorm files 42 ; SABS ByRef, arrays of SABS(SAB)=restriction level 43 ; RESTRICTED ByVal, include restricted sources. 1 for yes, 0 for no 44 N SABS D LOADSABS(.SABS) 45 I PATH="" QUIT 46 N FILENAME S FILENAME="RXNCONSO.RRF" 47 D DELFILED(176.001) ; delete data 48 N LINES S LINES=$$GETLINES(PATH,FILENAME) 49 N POP 50 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 51 IF POP D EN^DDIOL("Error reading file..., Please check...") G EX 52 N C0CCOUNT 53 N C0CSUPP S C0CSUPP=0 54 F C0CCOUNT=1:1 D Q:$$STATUS^%ZISH 55 . U IO 56 . N LINE R LINE:0 57 . IF $$STATUS^%ZISH QUIT 58 . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000 59 . ; 60 . ; If suppressed, quit 61 . N SUPP S SUPP=$P(LINE,"|",17) 62 . I SUPP="O"!(SUPP="Y")!(SUPP="E") S C0CSUPP=C0CSUPP+1 QUIT 63 . ; 64 . ; Deal with restriction level 65 . N SAB S SAB=$P(LINE,"|",12) 66 . I 'RESTRICTED,SABS(SAB) QUIT ; If not include restricted, and SABS(SAB) is not zero, quit 67 . ; 68 . ; Save data 69 . S ^C0CRXN(176.001,C0CCOUNT,0)=$TR(LINE,"|^","^|") 70 EX D CLOSE^%ZISH("FILE") 71 N DIK S DIK="^C0CRXN(176.001," D IXALL^DIK 72 W "Suppressed: ",C0CSUPP,! 73 QUIT 74 ; 75 ; 76 SAT(PATH,RESTRICTED) ; Open and read Concept and Atom attributes: RXNSAT.RRF 77 ; PATH ByVal, path of RxNorm files 78 ; SABS ByRef, arrays of SABS(SAB)=restriction level 79 ; RESTRICTED ByVal, include restricted sources. 1 for yes, 0 for no 80 N $ET S $ET="D ^%ZTER HALT" 81 S U="^" 82 I PATH="" QUIT 83 N FILENAME S FILENAME="RXNSAT.RRF" 84 D DELFILED(176.002) ; delete data 85 N LINES S LINES=$$GETLINES(PATH,FILENAME) 86 N POP 87 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 88 IF POP W "Error reading file..., Please check...",! G EX2 89 N SABS D LOADSABS(.SABS) 90 N C0CSUPP S C0CSUPP=0 91 N C0CCOUNT F C0CCOUNT=1:1 Q:$$STATUS^%ZISH D 92 . U IO 93 . N LINE R LINE:0 94 . IF $$STATUS^%ZISH QUIT 95 . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000 96 . ; 97 . ; If suppressed, quit 98 . N SUPP S SUPP=$P(LINE,"|",12) 99 . I SUPP="O"!(SUPP="Y")!(SUPP="E") S C0CSUPP=C0CSUPP+1 QUIT 100 . ; 101 . ; We switch around the fields .01 and .09 because the .01 isn't always present; where as .09 is required 102 . N RXCUI1,ATN9 103 . S RXCUI1=$P(LINE,"|",1) 104 . S ATN9=$P(LINE,"|",9) 105 . S $P(LINE,"|",1)=ATN9 106 . S $P(LINE,"|",9)=RXCUI1 107 . ; 108 . ; Deal with restricted sources 109 . N SAB S SAB=$P(LINE,"|",10) 110 . I 'RESTRICTED,SABS(SAB) QUIT ; If not include restricted, and SABS(SAB) is not zero, quit 111 . ; 112 . ; Save off 113 . S ^C0CRXN(176.002,C0CCOUNT,0)=$TR(LINE,"|^","^|") 114 EX2 D CLOSE^%ZISH("FILE") 115 N DIK S DIK="^C0CRXN(176.002," D IXALL^DIK 116 W "Suppressed: ",C0CSUPP,! 117 QUIT 118 ; 119 ; 120 SAB(PATH) ; Open the read RxNorm Sources file: RXNSAB.RRF 121 I PATH="" QUIT 122 N FILENAME S FILENAME="RXNSAB.RRF" 123 D DELFILED(176.003) ; delete data 124 N POP 125 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 126 IF POP W "Error reading file..., Please check...",! G EX3 127 N I F I=1:1 Q:$$STATUS^%ZISH D 128 . U IO 129 . N LINE R LINE:0 130 . IF $$STATUS^%ZISH QUIT 131 . U $P W I,! U IO ; Write I to the screen, then go back to reading the file 132 . ; Switch pieces 1 and 4 because 4 is always defined. Goes into .01 field. 133 . N VCUI S VCUI=$P(LINE,"|",1) 134 . N RSAB S RSAB=$P(LINE,"|",4) 135 . S $P(LINE,"|",1)=RSAB 136 . S $P(LINE,"|",4)=VCUI 137 . S ^C0CRXN(176.003,I,0)=$TR(LINE,"^|","|^") 138 EX3 D CLOSE^%ZISH("FILE") 139 N DIK S DIK="^C0CRXN(176.003," D IXALL^DIK 140 QUIT 141 ; 142 LOADSABS(SABS) ; 143 N C0CI F C0CI=0:0 S C0CI=$O(^C0CRXN(176.003,C0CI)) Q:'C0CI D 144 . S SABS($$GET1^DIQ(176.003,C0CI,.01))=$$GET1^DIQ(176.003,C0CI,"SRL") 145 QUIT 146 ; 147 STY(PATH) ; Open and read RxNorm Semantic types file: RXNSTY.RRF 148 I PATH="" QUIT 149 N FILENAME S FILENAME="RXNSTY.RRF" 150 D DELFILED(176.004) ; delete data 151 N LINES S LINES=$$GETLINES(PATH,FILENAME) ; Get # of lines 152 N POP 153 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 154 IF POP W "Error reading file..., Please check...",! G EX4 155 N I F I=1:1 Q:$$STATUS^%ZISH D 156 . U IO 157 . N LINE R LINE:0 158 . IF $$STATUS^%ZISH QUIT 159 . I '(I#1000) U $P W I," of ",LINES," read ",! U IO ; update every 1000 160 . S ^C0CRXN(176.004,I,0)=$TR(LINE,"^|","|^") 161 EX4 D CLOSE^%ZISH("FILE") 162 N DIK S DIK="^C0CRXN(176.004," D IXALL^DIK 163 QUIT 164 ; 165 REL(PATH) ; Open and read RxNorm Relationships file: RXNREL.RRF 166 I PATH="" QUIT 167 N FILENAME S FILENAME="RXNREL.RRF" 168 D DELFILED(176.005) ; delete data 169 N LINES S LINES=$$GETLINES(PATH,FILENAME) ; Get # of lines 170 N POP 171 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 172 IF POP W "Error reading file..., Please check...",! G EX5 173 N C0CSUPP S C0CSUPP=0 174 N I F I=1:1 Q:$$STATUS^%ZISH D 175 . U IO 176 . N LINE R LINE:0 177 . ; 178 . ; If suppressed, quit 179 . N SUPP S SUPP=$P(LINE,"|",15) 180 . I SUPP="O"!(SUPP="Y")!(SUPP="E") S C0CSUPP=C0CSUPP+1 QUIT 181 . ; 182 . IF $$STATUS^%ZISH QUIT 183 . I '(I#1000) U $P W I," of ",LINES," read ",! U IO ; update every 1000 184 . ; swap RXCUI1 location with SAB b/c SAB is required so can be .01 field 185 . N RXCUI1 S RXCUI1=$P(LINE,"|",1) 186 . N SAB S SAB=$P(LINE,"|",11) 187 . S $P(LINE,"|",1)=SAB 188 . S $P(LINE,"|",11)=RXCUI1 189 . S ^C0CRXN(176.005,I,0)=$TR(LINE,"^|","|^") 190 EX5 D CLOSE^%ZISH("FILE") 191 N DIK S DIK="^C0CRXN(176.005," D IXALL^DIK 192 W "Suppressed: ",C0CSUPP,! 193 QUIT 194 DOC(PATH) ; Open the read RxNorm Abbreviation Documentation file: RXNDOC.RRF 195 I PATH="" QUIT 196 N FILENAME S FILENAME="RXNDOC.RRF" 197 D DELFILED(176.006) ; delete data 198 N LINES S LINES=$$GETLINES(PATH,FILENAME) ; Get # of lines 199 N POP 200 D OPEN^%ZISH("FILE",PATH,FILENAME,"R") 201 IF POP W "Error reading file..., Please check...",! G EX6 202 N I F I=1:1 Q:$$STATUS^%ZISH D 203 . U IO 204 . N LINE R LINE:0 205 . IF $$STATUS^%ZISH QUIT 206 . I '(I#1000) U $P W I," of ",LINES," read ",! U IO ; update every 1000 207 . S ^C0CRXN(176.006,I,0)=$TR(LINE,"^|","|^") 208 EX6 D CLOSE^%ZISH("FILE") 209 N DIK S DIK="^C0CRXN(176.006," D IXALL^DIK 210 QUIT
Note:
See TracChangeset
for help on using the changeset viewer.
