Changeset 1540 for smart/trunk/p/C0SMED.m
- Timestamp:
- Sep 26, 2012, 1:00:27 PM (13 years ago)
- File:
-
- 1 edited
-
smart/trunk/p/C0SMED.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
smart/trunk/p/C0SMED.m
r1526 r1540 1 C0SMED ; GPL - Smart Meds Processing ;2/22/12 17:052 ;;0.1;C0S;nopatch;noreleasedate;Build 23 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU4 ;General Public License See attached copy of the License.5 ;6 ;This program is free software; you can redistribute it and/or modify7 ;it under the terms of the GNU General Public License as published by8 ;the Free Software Foundation; either version 2 of the License, or9 ;(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 of13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the14 ;GNU General Public License for more details.15 ;16 ;You should have received a copy of the GNU General Public License along17 ;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 Q21 ;22 MED(GRTN,C0SARY) ; GRTN, passed by reference,23 ; is the return name of the graph created. "" if none24 ; C0SARY is passed in by reference and is the NHIN array of meds25 ;26 I $O(C0SARY("med",""))="" D Q ;27 . I $D(DEBUG) W !,"No Meds"28 S GRTN="" ; default to no meds29 N C0SGRF30 S C0SGRF="vistaSmart:"_ZPATID_"/"_ZTYP31 I $D(DEBUG) W !,"Processing ",C0SGRF32 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph33 N MEDTRP ; MEDS TRIPLES34 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use35 N FARY S FARY="C0XFARY"36 D USEFARY^C0XF2N(FARY)37 D VOCINIT^C0XUTIL38 ;39 N DUPCHK S DUPCHK="" ; check for no duplicates40 N ZI S ZI=""41 F S ZI=$O(C0SARY("med",ZI)) Q:ZI="" D ;42 . N SDATE,SDTMP43 . I $G(C0SARY("med",ZI,"vaStatus@value"))="EXPIRED" D Q ;44 . . I $D(DEBUG) W !,"Expired Mediation, Skipping"45 . I $G(COSARY("med",ZI,"vaType@value"))="I" D Q ;46 . . I $D(DEBUG) W !,"Inpatient Med, skipping"47 . I $G(COSARY("med",ZI,"vaType@value"))="V" D Q ;48 . . I $D(DEBUG) W !,"IV Inpatient Med, skipping"49 . ;50 . S SDTMP=$G(C0SARY("med",ZI,"ordered@value"))51 . I SDTMP="" D ;52 . . S SDTMP=$G(C0SARY("med",ZI,"start@value"))53 . S SDATE=$$FMTE^XLFDT(SDTMP,"7D") ; ordered date54 . S SDATE=$TR(SDATE,"/","-") ; change slashes to hyphens55 . I SDATE="" S SDATE="UNKNOWN"56 . N DNAME,VUID,DCODE,RXNORM,SIG57 . S DNAME=$G(C0SARY("med",ZI,"name@value"))58 . I DNAME="" D ;59 . . S DNAME=$G(C0SARY("med",ZI,"products.product@name"))60 . S VUID=$G(C0SARY("med",ZI,"products.product.vaProduct@vuid"))61 . S DCODE=$G(C0SARY("med",ZI,"products.product.vaProduct@code"))62 . I DCODE="" S DCODE=$G(C0SARY("med",ZI,"id@value"))63 . S RXNORM=$$RXCUI(VUID) ; look up RxNorm code64 . I $P(RXNORM,"^",2)="RXNORM" D ;65 . . S RXVER=$P(RXNORM,"^",3)66 . . S RXNORM=$P(RXNORM,"^",1)67 . E D Q ;68 . . I $D(DEBUG) W !,"NO RXNORM NUMBER AVAILABLE"69 . . I $D(DEBUG) W !,RXNORM70 . I DNAME="" D Q ;71 . . I $D(DEBUG) W !,"Error No Drug Name"72 . S MEDGRF=C0SGRF_"/"_DCODE_"-"_$G(SDTMP)73 . I +$D(DUPCHK(MEDGRF)) D Q ; NO DUPS ALLOWED74 . . I $D(DEBUG) W !,"Found Duplicate Medication ",MEDGRF75 . S DUPCHK(MEDGRF)=""76 . I $D(DEBUG) D ;77 . . W !,"Processing Medication ",MEDGRF78 . . W !,DNAME79 . . W !,RXNORM80 . S SIG=$G(C0SARY("med",ZI,"sig"))81 . I SIG["|" D ;82 . . N SIGTMP83 . . S SIGTMP=SIG84 . . S SIG=$P(SIGTMP,"|",2) ; remove the drug name from the sig85 . . I DNAME["FREE TXT" D ; eRx free text drug, get drug name from sig86 . . . S DNAME=$P(SIGTMP,"|",1) ; eRx Drug name is stored as the first piece of the sig87 . K C0XFARY88 . D ADD^C0XF2N(C0SGRF,MEDGRF,"rdf:type","sp:Medication",FARY)89 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:belongsTo",C0SGRF,FARY)90 . N DSUBJ S DSUBJ=$$ANONS^C0XF2N ; anonomous subject91 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:drugName",DSUBJ,FARY)92 . I SIG'="" D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:instructions",SIG,FARY)93 . N NQTY,NQTY2,NFREQ,NFREQ294 . S NQTY=$$ANONS^C0XF2N ; anonomous subject95 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:quantity",NQTY,FARY)96 . S NQTY2=$$ANONS^C0XF2N ; anonomous subject97 . D ADD^C0XF2N(C0SGRF,NQTY,"sp:ValueAndUnit",NQTY2,FARY)98 . N DOSE S DOSE=$G(C0SARY("med",ZI,"doses.dose@dose"))99 . I DOSE="" S DOSE="UNKNOWN"100 . N UNIT S UNIT=$G(C0SARY("med",ZI,"doses.dose@units"))101 . I UNIT="" S UNIT="UNKNOWN"102 . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:value",DOSE,FARY)103 . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:unit",UNIT,FARY)104 . S NFREQ=$$ANONS^C0XF2N ; anonomous subject105 . S NFREQ2=$$ANONS^C0XF2N ; anonomous subject106 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:frequency",NFREQ,FARY)107 . D ADD^C0XF2N(C0SGRF,NFREQ,"sp:ValueAndUnit",NFREQ2,FARY)108 . N SCHED S SCHED=$G(C0SARY("med",ZI,"doses.dose@schedule"))109 . I SCHED="" S SCHED="UNKNOWN"110 . N SCHUNIT S SCHUNIT=$G(C0SARY("med",ZI,"doses.dose@route"))111 . I SCHUNIT="" S SCHUNIT="UNKNOWN"112 . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:value",SCHED,FARY)113 . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:unit",SCHUNIT,FARY)114 . D ADD^C0XF2N(C0SGRF,DSUBJ,"rdf:type","sp:CodedValue",FARY)115 . D ADD^C0XF2N(C0SGRF,DSUBJ,"sp:code","rxnorm:"_RXNORM,FARY)116 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","sp:Code",FARY)117 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:title",DNAME,FARY)118 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"sp:system","rxnorm:",FARY)119 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:identifier",RXNORM,FARY)120 . D ADD^C0XF2N(C0SGRF,DSUBJ,"dcterms:title",DNAME,FARY)121 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:startDate",SDATE,FARY)122 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","http://smartplatforms.org/terms/codes/RxNorm_Semantic",FARY)123 . D BULKLOAD^C0XF2N(.C0XFDA)124 . K C0XFDA125 S GRTN=C0SGRF126 q127 ;128 RXNFN() Q 1130590011.001 ; RxNorm Concepts file number129 ;130 RXCUI(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF131 ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR132 N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT133 I $G(ZVUID)="" Q ""134 I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED135 N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID")136 S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES137 N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)138 S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED139 I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"140 Q ZRSLT141 ;142 NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO143 ; CONFORM TO NIST REQUIREMENTS144 ;INPATIENT CERTIFICATION145 I ZRXN=309362 S ZRXN=213169146 I ZRXN=855318 S ZRXN=855320147 I ZRXN=197361 S ZRXN=212549148 ;OUTPATIENT CERTIFICATION149 I ZRXN=310534 S ZRXN=205875150 I ZRXN=617312 S ZRXN=617314151 I ZRXN=310429 S ZRXN=200801152 I ZRXN=628953 S ZRXN=628958153 I ZRXN=745679 S ZRXN=630208154 I ZRXN=311564 S ZRXN=979334155 I ZRXN=836343 S ZRXN=836370156 Q ZRXN157 ;1 C0SMED ; GPL - Smart Meds Processing ;2/22/12 17:05 2 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 3 ;Copyright 2012 George Lilly. 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 Q 21 ; 22 MED(GRTN,C0SARY) ; GRTN, passed by reference, 23 ; is the return name of the graph created. "" if none 24 ; C0SARY is passed in by reference and is the NHIN array of meds 25 ; 26 I $O(C0SARY("med",""))="" D Q ; 27 . I $D(DEBUG) W !,"No Meds" 28 S GRTN="" ; default to no meds 29 N C0SGRF 30 S C0SGRF="vistaSmart:"_ZPATID_"/"_ZTYP 31 I $D(DEBUG) W !,"Processing ",C0SGRF 32 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph 33 N MEDTRP ; MEDS TRIPLES 34 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use 35 N FARY S FARY="C0XFARY" 36 D USEFARY^C0XF2N(FARY) 37 D VOCINIT^C0XUTIL 38 ; 39 N DUPCHK S DUPCHK="" ; check for no duplicates 40 N ZI S ZI="" 41 F S ZI=$O(C0SARY("med",ZI)) Q:ZI="" D ; 42 . N SDATE,SDTMP 43 . I $G(C0SARY("med",ZI,"vaStatus@value"))="EXPIRED" D Q ; 44 . . I $D(DEBUG) W !,"Expired Mediation, Skipping" 45 . I $G(COSARY("med",ZI,"vaType@value"))="I" D Q ; 46 . . I $D(DEBUG) W !,"Inpatient Med, skipping" 47 . I $G(COSARY("med",ZI,"vaType@value"))="V" D Q ; 48 . . I $D(DEBUG) W !,"IV Inpatient Med, skipping" 49 . ; 50 . S SDTMP=$G(C0SARY("med",ZI,"ordered@value")) 51 . I SDTMP="" D ; 52 . . S SDTMP=$G(C0SARY("med",ZI,"start@value")) 53 . S SDATE=$$FMTE^XLFDT(SDTMP,"7D") ; ordered date 54 . S SDATE=$TR(SDATE,"/","-") ; change slashes to hyphens 55 . I SDATE="" S SDATE="UNKNOWN" 56 . N DNAME,VUID,DCODE,RXNORM,SIG 57 . S DNAME=$G(C0SARY("med",ZI,"name@value")) 58 . I DNAME="" D ; 59 . . S DNAME=$G(C0SARY("med",ZI,"products.product@name")) 60 . S VUID=$G(C0SARY("med",ZI,"products.product.vaProduct@vuid")) 61 . S DCODE=$G(C0SARY("med",ZI,"products.product.vaProduct@code")) 62 . I DCODE="" S DCODE=$G(C0SARY("med",ZI,"id@value")) 63 . S RXNORM=$$RXCUI(VUID) ; look up RxNorm code 64 . I $P(RXNORM,"^",2)="RXNORM" D ; 65 . . S RXVER=$P(RXNORM,"^",3) 66 . . S RXNORM=$P(RXNORM,"^",1) 67 . E D Q ; 68 . . I $D(DEBUG) W !,"NO RXNORM NUMBER AVAILABLE" 69 . . I $D(DEBUG) W !,RXNORM 70 . I DNAME="" D Q ; 71 . . I $D(DEBUG) W !,"Error No Drug Name" 72 . S MEDGRF=C0SGRF_"/"_DCODE_"-"_$G(SDTMP) 73 . I +$D(DUPCHK(MEDGRF)) D Q ; NO DUPS ALLOWED 74 . . I $D(DEBUG) W !,"Found Duplicate Medication ",MEDGRF 75 . S DUPCHK(MEDGRF)="" 76 . I $D(DEBUG) D ; 77 . . W !,"Processing Medication ",MEDGRF 78 . . W !,DNAME 79 . . W !,RXNORM 80 . S SIG=$G(C0SARY("med",ZI,"sig")) 81 . I SIG["|" D ; 82 . . N SIGTMP 83 . . S SIGTMP=SIG 84 . . S SIG=$P(SIGTMP,"|",2) ; remove the drug name from the sig 85 . . I DNAME["FREE TXT" D ; eRx free text drug, get drug name from sig 86 . . . S DNAME=$P(SIGTMP,"|",1) ; eRx Drug name is stored as the first piece of the sig 87 . K C0XFARY 88 . D ADD^C0XF2N(C0SGRF,MEDGRF,"rdf:type","sp:Medication",FARY) 89 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:belongsTo",C0SGRF,FARY) 90 . N DSUBJ S DSUBJ=$$ANONS^C0XF2N ; anonomous subject 91 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:drugName",DSUBJ,FARY) 92 . I SIG'="" D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:instructions",SIG,FARY) 93 . N NQTY,NQTY2,NFREQ,NFREQ2 94 . S NQTY=$$ANONS^C0XF2N ; anonomous subject 95 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:quantity",NQTY,FARY) 96 . S NQTY2=$$ANONS^C0XF2N ; anonomous subject 97 . D ADD^C0XF2N(C0SGRF,NQTY,"sp:ValueAndUnit",NQTY2,FARY) 98 . N DOSE S DOSE=$G(C0SARY("med",ZI,"doses.dose@dose")) 99 . I DOSE="" S DOSE="UNKNOWN" 100 . N UNIT S UNIT=$G(C0SARY("med",ZI,"doses.dose@units")) 101 . I UNIT="" S UNIT="UNKNOWN" 102 . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:value",DOSE,FARY) 103 . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:unit",UNIT,FARY) 104 . S NFREQ=$$ANONS^C0XF2N ; anonomous subject 105 . S NFREQ2=$$ANONS^C0XF2N ; anonomous subject 106 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:frequency",NFREQ,FARY) 107 . D ADD^C0XF2N(C0SGRF,NFREQ,"sp:ValueAndUnit",NFREQ2,FARY) 108 . N SCHED S SCHED=$G(C0SARY("med",ZI,"doses.dose@schedule")) 109 . I SCHED="" S SCHED="UNKNOWN" 110 . N SCHUNIT S SCHUNIT=$G(C0SARY("med",ZI,"doses.dose@route")) 111 . I SCHUNIT="" S SCHUNIT="UNKNOWN" 112 . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:value",SCHED,FARY) 113 . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:unit",SCHUNIT,FARY) 114 . D ADD^C0XF2N(C0SGRF,DSUBJ,"rdf:type","sp:CodedValue",FARY) 115 . D ADD^C0XF2N(C0SGRF,DSUBJ,"sp:code","rxnorm:"_RXNORM,FARY) 116 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","sp:Code",FARY) 117 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:title",DNAME,FARY) 118 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"sp:system","rxnorm:",FARY) 119 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:identifier",RXNORM,FARY) 120 . D ADD^C0XF2N(C0SGRF,DSUBJ,"dcterms:title",DNAME,FARY) 121 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:startDate",SDATE,FARY) 122 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","http://smartplatforms.org/terms/codes/RxNorm_Semantic",FARY) 123 . D BULKLOAD^C0XF2N(.C0XFDA) 124 . K C0XFDA 125 S GRTN=C0SGRF 126 q 127 ; 128 RXNFN() Q 1130590011.001 ; RxNorm Concepts file number 129 ; 130 RXCUI(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF 131 ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR 132 N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT 133 I $G(ZVUID)="" Q "" 134 I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED 135 N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID") 136 S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES 137 N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01) 138 S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED 139 I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F" 140 Q ZRSLT 141 ; 142 NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO 143 ; CONFORM TO NIST REQUIREMENTS 144 ;INPATIENT CERTIFICATION 145 I ZRXN=309362 S ZRXN=213169 146 I ZRXN=855318 S ZRXN=855320 147 I ZRXN=197361 S ZRXN=212549 148 ;OUTPATIENT CERTIFICATION 149 I ZRXN=310534 S ZRXN=205875 150 I ZRXN=617312 S ZRXN=617314 151 I ZRXN=310429 S ZRXN=200801 152 I ZRXN=628953 S ZRXN=628958 153 I ZRXN=745679 S ZRXN=630208 154 I ZRXN=311564 S ZRXN=979334 155 I ZRXN=836343 S ZRXN=836370 156 Q ZRXN 157 ;
Note:
See TracChangeset
for help on using the changeset viewer.
