source: ccr/trunk/p/CCRMEDS1.m@ 317

Last change on this file since 317 was 312, checked in by Sam Habiel, 16 years ago

Updated all meds files to use RxNorm codes instead of NDCs.

File size: 10.7 KB
Line 
1CCRMEDS ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08
2 ;;0.1;CCDCCR;;JUL 16,2008;
3 ; Copyright 2008 WorldVistA. 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 W "NO ENTRY FROM TOP",!
21 Q
22 ;
23EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
24 ;
25 ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
26 ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
27 ;
28 ; MEDS is return array from RPC.
29 ; MAP is a mapping variable map (store result) for each med
30 ; MED is holds each array element from MEDS(J), one medicine
31 ; J is a counter.
32 ;
33 ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
34 ; med data available.
35 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
36 ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
37 ; D PARY^GPLXPATH(MINXML)
38 N MEDS,MAP
39 K ^TMP($J)
40 D RX^PSO52API(DFN,"CCDCCR")
41 M MEDS=^TMP($J,"CCDCCR",DFN)
42 ; @(0) contains the number of meds or -1^NO DATA FOUND
43 ; If it is -1, we quit.
44 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
45 I DEBUG ZWR MEDS
46 N RXIEN S RXIEN=0
47 N MEDCOUNT S MEDCOUNT=0
48 S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP
49 S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY
50 F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="" D ; FOR EACH MEDICATION IN THE LIST
51 . S MEDCOUNT=MEDCOUNT+1
52 . I DEBUG W "RXIEN IS ",RXIEN,!
53 . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
54 . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN CCRMEDS
55 . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
56 . I DEBUG W "MAP= ",MAP,!
57 . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
58 . S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID
59 . ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
60 . S @MAP@("MEDISSUEDATETXT")="Issue Date"
61 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U))
62 . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
63 . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U))
64 . S @MAP@("MEDRXNOTXT")="Prescription Number"
65 . S @MAP@("MEDRXNO")=MED(.01)
66 . S @MAP@("MEDTYPETEXT")="Medication"
67 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
68 . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
69 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
70 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
71 . ; 12/30/08: I will be using RxNorm for coding...
72 . ; 176.001 is the file for Concepts; 176.003 is the file for
73 . ; sources (i.e. for RxNorm Version)
74 . ;
75 . ; We need the VUID first for the National Drug File entry first
76 . ; We get the VUID of the drug, by looking up the VA Product entry
77 . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
78 . ; Field 99.99 is the VUID.
79 . ;
80 . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
81 . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
82 . ; $$GET1^DIQ.
83 . ;
84 . ; I get the RxNorm name and version from the RxNorm Sources (file
85 . ; 176.003), by searching for "RXNORM", then get the data.
86 . N MEDIEN S MEDIEN=$P(MED(6),U)
87 . D NDF^PSS50(MEDIEN,,,,,"NDF")
88 . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
89 . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
90 . N VAPROD S VAPROD=$P(NDFDATA(22),U)
91 . ;
92 . ; NDFIEN is not necessarily defined; it won't be if the drug
93 . ; is not matched to the national drug file (e.g. if the drug is
94 . ; new on the market, compounded, or is a fake drug [blue pill].
95 . ; To protect against failure, I will put an if/else block
96 . ;
97 . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
98 . I NDFIEN D
99 . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
100 . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
101 . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
102 . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
103 . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
104 . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
105 . ;
106 . E S (RXNORM,RXNNAME,RXNVER)=""
107 . ; End if/else block
108 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
109 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
110 . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
111 . ;
112 . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
113 . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
114 . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
115 . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
116 . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
117 . ; Units, concentration, etc, come from another call
118 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
119 . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
120 . ; NDF Entry IEN, and VA Product IEN
121 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
122 . ; These have been collected above.
123 . N CONCDATA
124 . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
125 . ; and this will crash the call. So...
126 . I NDFIEN="" S CONCDATA=""
127 . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
128 . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
129 . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
130 . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
131 . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
132 . S @MAP@("MEDQUANTITYVALUE")=MED(7)
133 . ; Oddly, there is no easy place to find the dispense unit.
134 . ; It's not included in the original call, so we have to go to the drug file.
135 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
136 . ; Node 14.5 is the Dispense Unit
137 . D DATA^PSS50(MEDIEN,,,,,"QTY")
138 . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
139 . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
140 . ;
141 . ; --- START OF DIRECTIONS ---
142 . ; Sig data not in any API :-( Oh yes, you can get the whole thing, but...
143 . ; we want the compoenents.
144 . ; It's in node 6 of ^PSRX(IEN)
145 . ; So, here we go again
146 . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
147 . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
148 . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
149 . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
150 . ;
151 . N DIRNUM S DIRNUM=0 ; Sigline number
152 . S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS
153 . F S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM="" D
154 . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
155 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components.
156 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05.
157 . . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0)
158 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
159 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1)
160 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
161 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient
162 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient
163 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient
164 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
165 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
166 . . ; Invervals... again another call.
167 . . ; In the wisdom of the original programmers, the schedule is a free text field
168 . . ; However, it gets translated by a call to the administration schedule file
169 . . ; to see if that schedule exists.
170 . . ; That's the same thing I am going to do.
171 . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
172 . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
173 . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
174 . . ; So...
175 . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
176 . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
177 . . N INTERVAL
178 . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
179 . . E D
180 . . . N SUB S SUB=$O(SCHEDATA(0))
181 . . . S INTERVAL=SCHEDATA(SUB,2)
182 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
183 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
184 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)
185 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
186 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
187 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
188 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
189 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
190 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
191 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
192 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
193 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
194 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")=""
195 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
196 . . N DIRMOD S DIRMOD=$P(SIGDATA,U,6)
197 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"")
198 . ;
199 . ; --- END OF DIRECTIONS ---
200 . ;
201 . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
202 . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
203 . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
204 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
205 . S @MAP@("MEDRFNO")=MED(9)
206 . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
207 . K @RESULT
208 . D MAP^GPLXPATH(MINXML,MAP,RESULT)
209 . ; D PARY^GPLXPATH(RESULT)
210 . ; MAPPING DIRECTIONS
211 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
212 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
213 . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
214 . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
215 . ; N MDZ1,MDZNA
216 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
217 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
218 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
219 . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
220 . . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
221 . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
222 . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
223 N MEDTMP,MEDI
224 D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
225 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
226 . W "MEDICATION MISSING ",!
227 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
228 Q
229 ;
Note: See TracBrowser for help on using the repository browser.