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

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

Updated routines per the KIDS build
File size: 6.3 KB
Line 
1C0SMED ; 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 ;
22MED(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 ;
128RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
129 ;
130RXCUI(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 ;
142NISTMAP(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 TracBrowser for help on using the repository browser.