Changeset 1333 for ccr/branches/ohum/p/C0CUTIL.m

Timestamp:

Jan 4, 2012, 12:05:49 AM (14 years ago)

Author:

George Lilly

Message:

ohum new version

File:

• ccr/branches/ohum/p/C0CUTIL.m (modified) (2 diffs)

ccr/branches/ohum/p/C0CUTIL.m

@@ -1 +1 @@
 C0CUTIL ;WV/C0C/SMH - Various Utilites for generating the CCR/CCD;06/15/08
-        ;;0.1;C0C;;Jun 15, 2008;Build 38
+        ;;0.1;C0C;;Jun 15, 2008;Build 1
         ;Copyright 2008-2009 Sam Habiel & George Lilly.  
         ;Licensed under the terms of the GNU
@@ -136 +136 @@
         ;
 RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
- ;
-CODE(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF 
- ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR
- N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT
- I $G(ZVUID)="" Q ""
- I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED
- N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID")
- S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES
- N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)
- S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED
- I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"
- Q ZRSLT
- ;
-NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO 
- ; CONFORM TO NIST REQUIREMENTS
- ;INPATIENT CERTIFICATION
- I ZRXN=309362 S ZRXN=213169
- I ZRXN=855318 S ZRXN=855320
- I ZRXN=197361 S ZRXN=212549
- ;OUTPATIENT CERTIFICATION
- I ZRXN=310534 S ZRXN=205875
- I ZRXN=617312 S ZRXN=617314
- I ZRXN=310429 S ZRXN=200801
- I ZRXN=628953 S ZRXN=628958
- I ZRXN=745679 S ZRXN=630208
- I ZRXN=311564 S ZRXN=979334
- I ZRXN=836343 S ZRXN=836370
- Q ZRXN
- ;
+        ;
+CODE(ZVUID)     ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF 
+        ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR
+        N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT
+        I $G(ZVUID)="" Q ""
+        I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED
+        N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID")
+        S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES
+        N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)
+        S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED
+        I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"
+        Q ZRSLT
+        ;
+NISTMAP(ZRXN)   ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO 
+        ; CONFORM TO NIST REQUIREMENTS
+        ;INPATIENT CERTIFICATION
+        I ZRXN=309362 S ZRXN=213169
+        I ZRXN=855318 S ZRXN=855320
+        I ZRXN=197361 S ZRXN=212549
+        ;OUTPATIENT CERTIFICATION
+        I ZRXN=310534 S ZRXN=205875
+        I ZRXN=617312 S ZRXN=617314
+        I ZRXN=310429 S ZRXN=200801
+        I ZRXN=628953 S ZRXN=628958
+        I ZRXN=745679 S ZRXN=630208
+        I ZRXN=311564 S ZRXN=979334
+        I ZRXN=836343 S ZRXN=836370
+        Q ZRXN
+        ;
 RPMS()  ; Are we running on an RPMS system rather than Vista?
         Q $G(DUZ("AG"))="I" ; If User Agency is Indian Health Service