Changeset 1544 for ccr/trunk/p/C0CMED2.m
- Timestamp:
- Oct 1, 2012, 9:32:46 PM (12 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p
-
Property svn:mergeinfo
set to (toggle deleted branches)
/ccr/branches/ohum/p merged eligible /ccr/branches/ohum/o-old/p 1290 /ccr/branches/ohum/p/p 1287-1289
-
Property svn:mergeinfo
set to (toggle deleted branches)
-
ccr/trunk/p/C0CMED2.m
- Property svn:mergeinfo changed
/ccr/branches/ohum/p/C0CMED2.m (added) merged: 1325,1328-1330,1332-1333,1337-1338,1342,1428,1433
r1336 r1544 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 ; 1 C0CMED2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista 2 ;;1.2;C0C;;May 11, 2012;Build 47 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 ;OHUM/RUT COMMENTED (1ST PENDING MEDICATION WAS GETTING DUPLICATED) 259 . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 260 . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER 261 . I MEDFIRST S MEDFIRST=0 ;OHUM/RUT ADDED 262 N MEDTMP,MEDI 263 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 264 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 265 . W "Pending Medication MISSING ",! 266 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 267 Q 268 ; - Property svn:mergeinfo changed
Note:
See TracChangeset
for help on using the changeset viewer.