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