source: ccr/trunk/p/CCRMEDS2.m@ 313

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

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

File size: 12.9 KB
Line 
1CCRMEDS2 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Pending Meds;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 ; MINXML is the Input XML Template, passed by name
26 ; DFN is Patient IEN
27 ; OUTXML is the resultant XML.
28 ;
29 ; MEDS is return array from RPC.
30 ; MAP is a mapping variable map (store result) for each med
31 ; MED is holds each array element from MEDS, one medicine
32 ;
33 ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending
34 ; meds 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 ; File for pending meds is 52.41
38 ; Unfortuantely, API does not supply us with any useful info beyond
39 ; the IEN in 52.41, and the Med Name, and route.
40 ; So, most of the info is going to get pulled from 52.41.
41 N MEDS,MAP
42 K ^TMP($J)
43 D PEN^PSO5241(DFN,"CCDCCR")
44 M MEDS=^TMP($J,"CCDCCR",DFN)
45 ; @(0) contains the number of meds or -1^NO DATA FOUND
46 ; If it is -1, we quit.
47 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
48 I DEBUG ZWR MEDS
49 N RXIEN S RXIEN=0
50 N MEDCOUNT S MEDCOUNT=0
51 N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING
52 S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP
53 S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY
54 F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B" D ; FOR EACH MEDICATION IN THE LIST
55 . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT ; Dont' want refill request as a "pending" order
56 . S MEDCOUNT=MEDCOUNT+1
57 . I DEBUG W "RXIEN IS ",RXIEN,!
58 . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
59 . ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN CCRMEDS
60 . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
61 . I DEBUG W "MAP= ",MAP,!
62 . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
63 . S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
64 . ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
65 . S @MAP@("MEDISSUEDATETXT")="Issue Date"
66 . ; Field 6 is "Effective date", and we pull it in timson format w/ I
67 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT")
68 . ; Med never filled; next 4 fields are not applicable.
69 . S @MAP@("MEDLASTFILLDATETXT")=""
70 . S @MAP@("MEDLASTFILLDATE")=""
71 . S @MAP@("MEDRXNOTXT")=""
72 . S @MAP@("MEDRXNO")=""
73 . S @MAP@("MEDTYPETEXT")="Medication"
74 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
75 . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
76 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
77 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
78 . ; NDC not supplied in API, but is rather trivial to obtain
79 . ; MED(11) piece 1 has the IEN of the drug (file 50)
80 . ; IEN is field 31 in the drug file.
81 . ;
82 . ; MEDIEN (node 11 in the returned output) might not necessarily be defined
83 . ; It is not defined when a dose in not chosen in CPRS. There is a long
84 . ; series of fields that depend on it. We will use If and Else to deal
85 . ; with that
86 . N MEDIEN S MEDIEN=$P(MED(11),U)
87 . I +MEDIEN>0 D ; start of if/else block
88 . . ; 12/30/08: I will be using RxNorm for coding...
89 . . ; 176.001 is the file for Concepts; 176.003 is the file for
90 . . ; sources (i.e. for RxNorm Version)
91 . . ;
92 . . ; We need the VUID first for the National Drug File entry first
93 . . ; We get the VUID of the drug, by looking up the VA Product entry
94 . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
95 . . ; Field 99.99 is the VUID.
96 . . ;
97 . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
98 . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
99 . . ; $$GET1^DIQ.
100 . . ;
101 . . ; I get the RxNorm name and version from the RxNorm Sources (file
102 . . ; 176.003), by searching for "RXNORM", then get the data.
103 . . D NDF^PSS50(MEDIEN,,,,,"NDF")
104 . . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
105 . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
106 . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
107 . . ;
108 . . ; NDFIEN is not necessarily defined; it won't be if the drug
109 . . ; is not matched to the national drug file (e.g. if the drug is
110 . . ; new on the market, compounded, or is a fake drug [blue pill].
111 . . ; To protect against failure, I will put an if/else block
112 . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
113 . . I NDFIEN D
114 . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
115 . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
116 . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
117 . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
118 . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
119 . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
120 . . ;
121 . . E S (RXNORM,RXNNAME,RXNVER)=""
122 . . ; End if/else block
123 . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
124 . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
125 . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
126 . . ;
127 . . S @MAP@("MEDBRANDNAMETEXT")=""
128 . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
129 . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
130 . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
131 . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
132 . . ; Units, concentration, etc, come from another call
133 . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
134 . . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
135 . . ; NDF Entry IEN, and VA Product Name
136 . . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
137 . . ; Documented in the same manual; executed above.
138 . . N CONCDATA
139 . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
140 . . ; and this will crash the call. So...
141 . . I NDFIEN="" S CONCDATA=""
142 . . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
143 . . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
144 . . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
145 . . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
146 . . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
147 . . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
148 . . ; Oddly, there is no easy place to find the dispense unit.
149 . . ; It's not included in the original call, so we have to go to the drug file.
150 . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
151 . . ; Node 14.5 is the Dispense Unit
152 . . D DATA^PSS50(MEDIEN,,,,,"QTY")
153 . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
154 . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
155 . E D
156 . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
157 . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
158 . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
159 . . S @MAP@("MEDBRANDNAMETEXT")=""
160 . . S @MAP@("MEDSTRENGTHVALUE")=""
161 . . S @MAP@("MEDSTRENGTHUNIT")=""
162 . . S @MAP@("MEDFORMTEXT")=""
163 . . S @MAP@("MEDCONCVALUE")=""
164 . . S @MAP@("MEDCONCUNIT")=""
165 . . S @MAP@("MEDSIZETEXT")=""
166 . . S @MAP@("MEDQUANTITYVALUE")=""
167 . . S @MAP@("MEDQUANTITYUNIT")=""
168 . ; end of if/else block
169 . ;
170 . ; --- START OF DIRECTIONS ---
171 . ; Sig data is not in any API. We obtain it using the IEN from
172 . ; the PEN API to file 52.41. It's in field 3, which is a multiple.
173 . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
174 . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
175 . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
176 . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
177 . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
178 . ; DIRNUM will be first piece for IEN.
179 . ; DIRNUM is the proper Sigline numer.
180 . ; SIGDATA is the simplfied array. Subscripts are really field numbers
181 . ; in subfile 52.413.
182 . N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
183 . F S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM="" D
184 . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
185 . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
186 . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
187 . . ; If this is an order for a refill; it's not really a new order; move on to next
188 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components.
189 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05.
190 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
191 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
192 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
193 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient
194 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient
195 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient
196 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
197 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
198 . . ; Invervals... again another call.
199 . . ; The schedule is a free text field
200 . . ; However, it gets translated by a call to the administration
201 . . ; schedule file to see if that schedule exists.
202 . . ; That's the same thing I am going to do.
203 . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
204 . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
205 . . ; I looked), PSSFT is the name,
206 . . ; and list is the ^TMP name to store the data in.
207 . . ; Also, freqency may have "PRN" in it, so strip that out
208 . . N FREQ S FREQ=SIGDATA(1)
209 . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
210 . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
211 . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
212 . . N INTERVAL
213 . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
214 . . E D
215 . . . N SUB S SUB=$O(SCHEDATA(0))
216 . . . S INTERVAL=SCHEDATA(SUB,2)
217 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
218 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
219 . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
220 . . N DUR S DUR=SIGDATA(2)
221 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
222 . . N DURUNIT S DURUNIT=$E(DUR)
223 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
224 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
225 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
226 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
227 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
228 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
229 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
230 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
231 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
232 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
233 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
234 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
235 . ;
236 . ; --- END OF DIRECTIONS ---
237 . ;
238 . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
239 . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
240 . ; W @MAP@("MEDPTINSTRUCTIONS"),!
241 . ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
242 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
243 . ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
244 . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
245 . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
246 . K @RESULT
247 . D MAP^GPLXPATH(MINXML,MAP,RESULT)
248 . ; D PARY^GPLXPATH(RESULT)
249 . ; MAPPING DIRECTIONS
250 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
251 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
252 . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
253 . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
254 . ; N MDZ1,MDZNA
255 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
256 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
257 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
258 . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
259 . . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
260 . I MEDFIRST D ;
261 . . S MEDFIRST=0 ; RESET FIRST FLAG
262 . . D CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
263 . D:'MEDFIRST INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
264 N MEDTMP,MEDI
265 D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
266 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
267 . W "MEDICATION MISSING ",!
268 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
269 Q
270 ;
Note: See TracBrowser for help on using the repository browser.