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

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

Added CCRMEDS4 for inpatient UD, and tiny fixes for the FMDTOUTCCCRUTIL call for CCRMEDS1 and 2
File size: 10.7 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 . N MEDIEN S MEDIEN=$P(MED(11),U)
82 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=$$GET1^DIQ(50,MEDIEN,31,"E")
83 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
84 . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
85 . S @MAP@("MEDBRANDNAMETEXT")=""
86 . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
87 . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
88 . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
89 . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
90 . ; Units, concentration, etc, come from another call
91 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
92 . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
93 . ; NDF Entry IEN, and VA Product Name
94 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
95 . ; Documented in the same manual.
96 . D NDF^PSS50(MEDIEN,,,,,"CONC")
97 . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN)
98 . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
99 . N VAPROD S VAPROD=$P(NDFDATA(22),U)
100 . N CONCDATA
101 . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
102 . ; and this will crash the call. So...
103 . I NDFIEN="" S CONCDATA=""
104 . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
105 . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
106 . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
107 . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
108 . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
109 . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
110 . ; Oddly, there is no easy place to find the dispense unit.
111 . ; It's not included in the original call, so we have to go to the drug file.
112 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
113 . ; Node 14.5 is the Dispense Unit
114 . D DATA^PSS50(MEDIEN,,,,,"QTY")
115 . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
116 . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
117 . ;
118 . ; --- START OF DIRECTIONS ---
119 . ; Sig data is not in any API. We obtain it using the IEN from
120 . ; the PEN API to file 52.41. It's in field 3, which is a multiple.
121 . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
122 . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
123 . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
124 . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
125 . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
126 . ; DIRNUM will be first piece for IEN.
127 . ; DIRNUM is the proper Sigline numer.
128 . ; SIGDATA is the simplfied array. Subscripts are really field numbers
129 . ; in subfile 52.413.
130 . N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
131 . F S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM="" D
132 . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
133 . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
134 . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
135 . . ; If this is an order for a refill; it's not really a new order; move on to next
136 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components.
137 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05.
138 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
139 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
140 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
141 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient
142 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient
143 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient
144 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
145 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
146 . . ; Invervals... again another call.
147 . . ; The schedule is a free text field
148 . . ; However, it gets translated by a call to the administration
149 . . ; schedule file to see if that schedule exists.
150 . . ; That's the same thing I am going to do.
151 . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
152 . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
153 . . ; I looked), PSSFT is the name,
154 . . ; and list is the ^TMP name to store the data in.
155 . . ; Also, freqency may have "PRN" in it, so strip that out
156 . . N FREQ S FREQ=SIGDATA(1)
157 . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
158 . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
159 . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
160 . . N INTERVAL
161 . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
162 . . E D
163 . . . N SUB S SUB=$O(SCHEDATA(0))
164 . . . S INTERVAL=SCHEDATA(SUB,2)
165 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
166 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
167 . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
168 . . N DUR S DUR=SIGDATA(2)
169 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
170 . . N DURUNIT S DURUNIT=$E(DUR)
171 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
172 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
173 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
174 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
175 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
176 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
177 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
178 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
179 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
180 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
181 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
182 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
183 . ;
184 . ; --- END OF DIRECTIONS ---
185 . ;
186 . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
187 . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
188 . ; W @MAP@("MEDPTINSTRUCTIONS"),!
189 . ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
190 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
191 . ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
192 . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
193 . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
194 . K @RESULT
195 . D MAP^GPLXPATH(MINXML,MAP,RESULT)
196 . ; D PARY^GPLXPATH(RESULT)
197 . ; MAPPING DIRECTIONS
198 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
199 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
200 . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
201 . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
202 . ; N MDZ1,MDZNA
203 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
204 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
205 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
206 . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
207 . . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
208 . I MEDFIRST D ;
209 . . S MEDFIRST=0 ; RESET FIRST FLAG
210 . . D CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
211 . D:'MEDFIRST INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
212 N MEDTMP,MEDI
213 D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
214 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
215 . W "MEDICATION MISSING ",!
216 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
217 Q
218 ;
Note: See TracBrowser for help on using the repository browser.