source: smart/trunk/p/C0SMED.m@ 1790

Last change on this file since 1790 was 1591, checked in by Sam Habiel, 12 years ago

Updated license for routines
File size: 6.2 KB
Line 
1C0SMED ; 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 ;
20MED(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 ;
126RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
127 ;
128RXCUI(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 ;
140NISTMAP(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 ;
Note: See TracBrowser for help on using the repository browser.