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

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

Fixed CCRMEDS2 to not display refills requests from CPRS as pending orders
File size: 9.1 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 F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B" D ; FOR EACH MEDICATION IN THE LIST
52 . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT ; Dont' want refill request as a "pending" order
53 . S MEDCOUNT=MEDCOUNT+1
54 . I DEBUG W "RXIEN IS ",RXIEN,!
55 . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
56 . K @MAP
57 . I DEBUG W "MAP= ",MAP,!
58 . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
59 . S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
60 . S @MAP@("MEDISSUEDATETXT")="Issue Date"
61 . ; Field 6 is "Effective date", and we pull it in timson format w/ I
62 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"))
63 . ; Med never filled; next 4 fields are not applicable.
64 . S @MAP@("MEDLASTFILLDATETXT")=""
65 . S @MAP@("MEDLASTFILLDATE")=""
66 . S @MAP@("MEDRXNOTXT")=""
67 . S @MAP@("MEDRXNO")=""
68 . S @MAP@("MEDTYPETEXT")="Medication"
69 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
70 . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
71 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
72 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
73 . ; NDC not supplied in API, but is rather trivial to obtain
74 . ; MED(11) piece 1 has the IEN of the drug (file 50)
75 . ; IEN is field 31 in the drug file.
76 . N MEDIEN S MEDIEN=$P(MED(11),U)
77 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=$$GET1^DIQ(50,MEDIEN,31,"E")
78 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
79 . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
80 . S @MAP@("MEDBRANDNAMETEXT")=""
81 . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
82 . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
83 . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
84 . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
85 . ; Units, concentration, etc, come from another call
86 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
87 . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
88 . ; NDF Entry IEN, and VA Product Name
89 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
90 . ; Documented in the same manual.
91 . D NDF^PSS50(MEDIEN,,,,,"CONC")
92 . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN)
93 . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
94 . N VAPROD S VAPROD=$P(NDFDATA(22),U)
95 . N CONCDATA
96 . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
97 . ; and this will crash the call. So...
98 . I NDFIEN="" S CONCDATA=""
99 . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
100 . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
101 . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
102 . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
103 . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
104 . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
105 . ; Oddly, there is no easy place to find the dispense unit.
106 . ; It's not included in the original call, so we have to go to the drug file.
107 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
108 . ; Node 14.5 is the Dispense Unit
109 . D DATA^PSS50(MEDIEN,,,,,"QTY")
110 . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
111 . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
112 . ;
113 . ; --- START OF DIRECTIONS ---
114 . ; Sig data is not in any API. We obtain it using the IEN from
115 . ; the PEN API to file 52.41. It's in field 3, which is a multiple.
116 . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
117 . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
118 . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
119 . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
120 . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
121 . ; DIRNUM will be first piece for IEN.
122 . ; DIRNUM is the proper Sigline numer.
123 . ; SIGDATA is the simplfied array. Subscripts are really field numbers
124 . ; in subfile 52.413.
125 . F S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM="" D
126 . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
127 . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
128 . . ; If this is an order for a refill; it's not really a new order; move on to next
129 . . S @MAP@("M",DIRNUM,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components.
130 . . S @MAP@("M",DIRNUM,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05.
131 . . S @MAP@("M",DIRNUM,"MEDDELIVERYMETHOD")=SIGDATA(13)
132 . . S @MAP@("M",DIRNUM,"MEDDOSEVALUE")=SIGDATA(8)
133 . . S @MAP@("M",DIRNUM,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
134 . . S @MAP@("M",DIRNUM,"MEDRATEVALUE")="" ; For inpatient
135 . . S @MAP@("M",DIRNUM,"MEDRATEUNIT")="" ; For inpatient
136 . . S @MAP@("M",DIRNUM,"MEDVEHICLETEXT")="" ; For inpatient
137 . . S @MAP@("M",DIRNUM,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
138 . . S @MAP@("M",DIRNUM,"MEDFREQUENCYVALUE")=SIGDATA(1)
139 . . ; Invervals... again another call.
140 . . ; The schedule is a free text field
141 . . ; However, it gets translated by a call to the administration
142 . . ; schedule file to see if that schedule exists.
143 . . ; That's the same thing I am going to do.
144 . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
145 . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
146 . . ; I looked), PSSFT is the name,
147 . . ; and list is the ^TMP name to store the data in.
148 . . ; Also, freqency may have "PRN" in it, so strip that out
149 . . N FREQ S FREQ=SIGDATA(1)
150 . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
151 . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
152 . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
153 . . N INTERVAL
154 . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
155 . . E D
156 . . . N SUB S SUB=$O(SCHEDATA(0))
157 . . . S INTERVAL=SCHEDATA(SUB,2)
158 . . S @MAP@("M",DIRNUM,"MEDINTERVALVALUE")=INTERVAL
159 . . S @MAP@("M",DIRNUM,"MEDINTERVALUNIT")="Minute"
160 . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
161 . . N DUR S DUR=SIGDATA(2)
162 . . S @MAP@("M",DIRNUM,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
163 . . N DURUNIT S DURUNIT=$E(DUR)
164 . . S @MAP@("M",DIRNUM,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
165 . . S @MAP@("M",DIRNUM,"MEDPRNFLAG")=SIGDATA(1)["PRN"
166 . . S @MAP@("M",DIRNUM,"MEDPROBLEMOBJECTID")=""
167 . . S @MAP@("M",DIRNUM,"MEDPROBLEMTYPETXT")=""
168 . . S @MAP@("M",DIRNUM,"MEDPROBLEMDESCRIPTION")=""
169 . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODEVALUE")=""
170 . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODINGSYSTEM")=""
171 . . S @MAP@("M",DIRNUM,"MEDPROBLEMCODINGVERSION")=""
172 . . S @MAP@("M",DIRNUM,"MEDPROBLEMSOURCEACTORID")=""
173 . . S @MAP@("M",DIRNUM,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
174 . . S @MAP@("M",DIRNUM,"MEDDIRSEQ")=DIRNUM
175 . . S @MAP@("M",DIRNUM,"MEDMULDIRMOD")=SIGDATA(6)
176 . ;
177 . ; --- END OF DIRECTIONS ---
178 . ;
179 . S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
180 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
181 . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
182 . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
183 . K @RESULT
184 . D MAP^GPLXPATH(MINXML,MAP,RESULT)
185 . ; D PARY^GPLXPATH(RESULT)
186 . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
187 . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
188 N MEDTMP,MEDI
189 D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
190 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
191 . W "MEDICATION MISSING ",!
192 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
193 Q
194 ;
Note: See TracBrowser for help on using the repository browser.