| 1 | C0SMED ; GPL - Smart Meds Processing ;2/22/12 17:05
|
|---|
| 2 | ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5
|
|---|
| 3 | ;Copyright 2012 George Lilly.
|
|---|
| 4 | ;
|
|---|
| 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.
|
|---|
| 9 | ;
|
|---|
| 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.
|
|---|
| 14 | ;
|
|---|
| 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/>.
|
|---|
| 17 | ;
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | MED(GRTN,C0SARY) ; GRTN, passed by reference,
|
|---|
| 21 | ; is the return name of the graph created. "" if none
|
|---|
| 22 | ; C0SARY is passed in by reference and is the NHIN array of meds
|
|---|
| 23 | ;
|
|---|
| 24 | I $O(C0SARY("med",""))="" D Q ;
|
|---|
| 25 | . I $D(DEBUG) W !,"No Meds"
|
|---|
| 26 | S GRTN="" ; default to no meds
|
|---|
| 27 | N C0SGRF
|
|---|
| 28 | S C0SGRF="vistaSmart:"_ZPATID_"/"_ZTYP
|
|---|
| 29 | I $D(DEBUG) W !,"Processing ",C0SGRF
|
|---|
| 30 | D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
|
|---|
| 31 | N MEDTRP ; MEDS TRIPLES
|
|---|
| 32 | D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
|
|---|
| 33 | N FARY S FARY="C0XFARY"
|
|---|
| 34 | D USEFARY^C0XF2N(FARY)
|
|---|
| 35 | D VOCINIT^C0XUTIL
|
|---|
| 36 | ;
|
|---|
| 37 | N DUPCHK S DUPCHK="" ; check for no duplicates
|
|---|
| 38 | N ZI S ZI=""
|
|---|
| 39 | F S ZI=$O(C0SARY("med",ZI)) Q:ZI="" D ;
|
|---|
| 40 | . N SDATE,SDTMP
|
|---|
| 41 | . I $G(C0SARY("med",ZI,"vaStatus@value"))="EXPIRED" D Q ;
|
|---|
| 42 | . . I $D(DEBUG) W !,"Expired Mediation, Skipping"
|
|---|
| 43 | . I $G(COSARY("med",ZI,"vaType@value"))="I" D Q ;
|
|---|
| 44 | . . I $D(DEBUG) W !,"Inpatient Med, skipping"
|
|---|
| 45 | . I $G(COSARY("med",ZI,"vaType@value"))="V" D Q ;
|
|---|
| 46 | . . I $D(DEBUG) W !,"IV Inpatient Med, skipping"
|
|---|
| 47 | . ;
|
|---|
| 48 | . S SDTMP=$G(C0SARY("med",ZI,"ordered@value"))
|
|---|
| 49 | . I SDTMP="" D ;
|
|---|
| 50 | . . S SDTMP=$G(C0SARY("med",ZI,"start@value"))
|
|---|
| 51 | . S SDATE=$$FMTE^XLFDT(SDTMP,"7D") ; ordered date
|
|---|
| 52 | . S SDATE=$TR(SDATE,"/","-") ; change slashes to hyphens
|
|---|
| 53 | . I SDATE="" S SDATE="UNKNOWN"
|
|---|
| 54 | . N DNAME,VUID,DCODE,RXNORM,SIG
|
|---|
| 55 | . S DNAME=$G(C0SARY("med",ZI,"name@value"))
|
|---|
| 56 | . I DNAME="" D ;
|
|---|
| 57 | . . S DNAME=$G(C0SARY("med",ZI,"products.product@name"))
|
|---|
| 58 | . S VUID=$G(C0SARY("med",ZI,"products.product.vaProduct@vuid"))
|
|---|
| 59 | . S DCODE=$G(C0SARY("med",ZI,"products.product.vaProduct@code"))
|
|---|
| 60 | . I DCODE="" S DCODE=$G(C0SARY("med",ZI,"id@value"))
|
|---|
| 61 | . S RXNORM=$$RXCUI(VUID) ; look up RxNorm code
|
|---|
| 62 | . I $P(RXNORM,"^",2)="RXNORM" D ;
|
|---|
| 63 | . . S RXVER=$P(RXNORM,"^",3)
|
|---|
| 64 | . . S RXNORM=$P(RXNORM,"^",1)
|
|---|
| 65 | . E D Q ;
|
|---|
| 66 | . . I $D(DEBUG) W !,"NO RXNORM NUMBER AVAILABLE"
|
|---|
| 67 | . . I $D(DEBUG) W !,RXNORM
|
|---|
| 68 | . I DNAME="" D Q ;
|
|---|
| 69 | . . I $D(DEBUG) W !,"Error No Drug Name"
|
|---|
| 70 | . S MEDGRF=C0SGRF_"/"_DCODE_"-"_$G(SDTMP)
|
|---|
| 71 | . I +$D(DUPCHK(MEDGRF)) D Q ; NO DUPS ALLOWED
|
|---|
| 72 | . . I $D(DEBUG) W !,"Found Duplicate Medication ",MEDGRF
|
|---|
| 73 | . S DUPCHK(MEDGRF)=""
|
|---|
| 74 | . I $D(DEBUG) D ;
|
|---|
| 75 | . . W !,"Processing Medication ",MEDGRF
|
|---|
| 76 | . . W !,DNAME
|
|---|
| 77 | . . W !,RXNORM
|
|---|
| 78 | . S SIG=$G(C0SARY("med",ZI,"sig"))
|
|---|
| 79 | . I SIG["|" D ;
|
|---|
| 80 | . . N SIGTMP
|
|---|
| 81 | . . S SIGTMP=SIG
|
|---|
| 82 | . . S SIG=$P(SIGTMP,"|",2) ; remove the drug name from the sig
|
|---|
| 83 | . . I DNAME["FREE TXT" D ; eRx free text drug, get drug name from sig
|
|---|
| 84 | . . . S DNAME=$P(SIGTMP,"|",1) ; eRx Drug name is stored as the first piece of the sig
|
|---|
| 85 | . K C0XFARY
|
|---|
| 86 | . D ADD^C0XF2N(C0SGRF,MEDGRF,"rdf:type","sp:Medication",FARY)
|
|---|
| 87 | . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:belongsTo",C0SGRF,FARY)
|
|---|
| 88 | . N DSUBJ S DSUBJ=$$ANONS^C0XF2N ; anonomous subject
|
|---|
| 89 | . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:drugName",DSUBJ,FARY)
|
|---|
| 90 | . I SIG'="" D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:instructions",SIG,FARY)
|
|---|
| 91 | . N NQTY,NQTY2,NFREQ,NFREQ2
|
|---|
| 92 | . S NQTY=$$ANONS^C0XF2N ; anonomous subject
|
|---|
| 93 | . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:quantity",NQTY,FARY)
|
|---|
| 94 | . S NQTY2=$$ANONS^C0XF2N ; anonomous subject
|
|---|
| 95 | . D ADD^C0XF2N(C0SGRF,NQTY,"sp:ValueAndUnit",NQTY2,FARY)
|
|---|
| 96 | . N DOSE S DOSE=$G(C0SARY("med",ZI,"doses.dose@dose"))
|
|---|
| 97 | . I DOSE="" S DOSE="UNKNOWN"
|
|---|
| 98 | . N UNIT S UNIT=$G(C0SARY("med",ZI,"doses.dose@units"))
|
|---|
| 99 | . I UNIT="" S UNIT="UNKNOWN"
|
|---|
| 100 | . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:value",DOSE,FARY)
|
|---|
| 101 | . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:unit",UNIT,FARY)
|
|---|
| 102 | . S NFREQ=$$ANONS^C0XF2N ; anonomous subject
|
|---|
| 103 | . S NFREQ2=$$ANONS^C0XF2N ; anonomous subject
|
|---|
| 104 | . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:frequency",NFREQ,FARY)
|
|---|
| 105 | . D ADD^C0XF2N(C0SGRF,NFREQ,"sp:ValueAndUnit",NFREQ2,FARY)
|
|---|
| 106 | . N SCHED S SCHED=$G(C0SARY("med",ZI,"doses.dose@schedule"))
|
|---|
| 107 | . I SCHED="" S SCHED="UNKNOWN"
|
|---|
| 108 | . N SCHUNIT S SCHUNIT=$G(C0SARY("med",ZI,"doses.dose@route"))
|
|---|
| 109 | . I SCHUNIT="" S SCHUNIT="UNKNOWN"
|
|---|
| 110 | . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:value",SCHED,FARY)
|
|---|
| 111 | . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:unit",SCHUNIT,FARY)
|
|---|
| 112 | . D ADD^C0XF2N(C0SGRF,DSUBJ,"rdf:type","sp:CodedValue",FARY)
|
|---|
| 113 | . D ADD^C0XF2N(C0SGRF,DSUBJ,"sp:code","rxnorm:"_RXNORM,FARY)
|
|---|
| 114 | . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","sp:Code",FARY)
|
|---|
| 115 | . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:title",DNAME,FARY)
|
|---|
| 116 | . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"sp:system","rxnorm:",FARY)
|
|---|
| 117 | . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:identifier",RXNORM,FARY)
|
|---|
| 118 | . D ADD^C0XF2N(C0SGRF,DSUBJ,"dcterms:title",DNAME,FARY)
|
|---|
| 119 | . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:startDate",SDATE,FARY)
|
|---|
| 120 | . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","http://smartplatforms.org/terms/codes/RxNorm_Semantic",FARY)
|
|---|
| 121 | . D BULKLOAD^C0XF2N(.C0XFDA)
|
|---|
| 122 | . K C0XFDA
|
|---|
| 123 | S GRTN=C0SGRF
|
|---|
| 124 | q
|
|---|
| 125 | ;
|
|---|
| 126 | RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
|
|---|
| 127 | ;
|
|---|
| 128 | RXCUI(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF
|
|---|
| 129 | ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR
|
|---|
| 130 | N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT
|
|---|
| 131 | I $G(ZVUID)="" Q ""
|
|---|
| 132 | I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED
|
|---|
| 133 | N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID")
|
|---|
| 134 | S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES
|
|---|
| 135 | N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)
|
|---|
| 136 | S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED
|
|---|
| 137 | I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"
|
|---|
| 138 | Q ZRSLT
|
|---|
| 139 | ;
|
|---|
| 140 | NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO
|
|---|
| 141 | ; CONFORM TO NIST REQUIREMENTS
|
|---|
| 142 | ;INPATIENT CERTIFICATION
|
|---|
| 143 | I ZRXN=309362 S ZRXN=213169
|
|---|
| 144 | I ZRXN=855318 S ZRXN=855320
|
|---|
| 145 | I ZRXN=197361 S ZRXN=212549
|
|---|
| 146 | ;OUTPATIENT CERTIFICATION
|
|---|
| 147 | I ZRXN=310534 S ZRXN=205875
|
|---|
| 148 | I ZRXN=617312 S ZRXN=617314
|
|---|
| 149 | I ZRXN=310429 S ZRXN=200801
|
|---|
| 150 | I ZRXN=628953 S ZRXN=628958
|
|---|
| 151 | I ZRXN=745679 S ZRXN=630208
|
|---|
| 152 | I ZRXN=311564 S ZRXN=979334
|
|---|
| 153 | I ZRXN=836343 S ZRXN=836370
|
|---|
| 154 | Q ZRXN
|
|---|
| 155 | ;
|
|---|
