Changeset 1337 for ccr/branches/ohum/p/C0CMED1.m
- Timestamp:
- Jan 4, 2012, 9:40:24 PM (13 years ago)
- File:
-
- 1 edited
-
ccr/branches/ohum/p/C0CMED1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/branches/ohum/p/C0CMED1.m
r1333 r1337 1 C0CMED1 2 ;;1.0;C0C;;May 19, 2009;Build 1 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,FLAGS) 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 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 Q 59 60 61 F S RXIEN=$O(MEDS(RXIEN)) Q:$G(RXIEN)="" D ; FOR EACH MEDICATION IN THE LIST62 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 1 C0CMED1 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;01/10/09 2 ;;1.0;C0C;;May 19, 2009;Build 38 3 ;;Last modified Sat Jan 10 21:42:27 PST 2009 4 ; Copyright 2009 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,FLAGS) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 25 ; 26 ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 27 ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE 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(J), one medicine 32 ; MEDCOUNT is a counter passed by Reference. 33 ; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool) 34 ; FLAGS are set-up in C0CMED. 35 ; 36 ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all 37 ; med data available. 38 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf 39 ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS). 40 ; D PARY^C0CXPATH(MINXML) 41 N MEDS,MAP 42 K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!! 43 N ALL S ALL=+FLAGS 44 N ACTIVE S ACTIVE=$P(FLAGS,U,3) 45 ; Below, X1 is today; X2 is the number of days we want to go back 46 ; X is the result of this calculation using C^%DTC. 47 N X,X1,X2 48 S X1=DT 49 S X2=-$P($P(FLAGS,U,2),"-",2) 50 D C^%DTC 51 ; I discovered that I shouldn't put an ending date (last parameter) 52 ; because it seems that it will get meds whose beginning is after X but 53 ; whose exipriation is before the ending date. 54 D RX^PSO52API(DFN,"CCDCCR","","","",X,"") 55 M MEDS=^TMP($J,"CCDCCR",DFN) 56 ; @(0) contains the number of meds or -1^NO DATA FOUND 57 ; If it is -1, we quit. 58 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT 59 ZWRITE:$G(DEBUG) MEDS 60 N RXIEN S RXIEN=0 61 F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="" D ; FOR EACH MEDICATION IN THE LIST 62 . N MED M MED=MEDS(RXIEN) 63 . I 'ALL,ACTIVE,$P(MED(100),U,2)'="ACTIVE" QUIT 64 . S MEDCOUNT=MEDCOUNT+1 65 . W:$G(DEBUG) "RXIEN IS ",RXIEN,! 66 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT)) 67 . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED 68 . W:$G(DEBUG) "MAP= ",MAP,! 69 . S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID 70 . ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number 71 . S @MAP@("MEDISSUEDATETXT")="Issue Date" 72 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(1),U)) 73 . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date" 74 . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P($G(MED(101)),U)) 75 . S @MAP@("MEDRXNOTXT")="Prescription Number" 76 . S @MAP@("MEDRXNO")=MED(.01) 77 . S @MAP@("MEDTYPETEXT")="Medication" 78 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 79 . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2) 80 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U) 81 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2) 82 . ; 12/30/08: I will be using RxNorm for coding... 83 . ; 176.001 is the file for Concepts; 176.003 is the file for 84 . ; sources (i.e. for RxNorm Version) 85 . ; 86 . ; We need the VUID first for the National Drug File entry first 87 . ; We get the VUID of the drug, by looking up the VA Product entry 88 . ; (file 50.68) using the call NDF^PSS50, returned in node 22. 89 . ; Field 99.99 is the VUID. 90 . ; 91 . ; We use the VUID to look up the RxNorm in file 176.001; same idea. 92 . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by 93 . ; $$GET1^DIQ. 94 . ; 95 . ; I get the RxNorm name and version from the RxNorm Sources (file 96 . ; 176.003), by searching for "RXNORM", then get the data. 97 . N MEDIEN S MEDIEN=$P(MED(6),U) 98 . D NDF^PSS50(MEDIEN,,,,,"NDF") 99 . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN) 100 . N NDFIEN S NDFIEN=$P(NDFDATA(20),U) 101 . N VAPROD S VAPROD=$P(NDFDATA(22),U) 102 . ; 103 . ; NDFIEN is not necessarily defined; it won't be if the drug 104 . ; is not matched to the national drug file (e.g. if the drug is 105 . ; new on the market, compounded, or is a fake drug [blue pill]. 106 . ; To protect against failure, I will put an if/else block 107 . ; 108 . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER 109 . I NDFIEN,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet. 110 . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99) 111 . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID") 112 . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01) 113 . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM") 114 . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6) 115 . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7) 116 . ; 117 . E S (RXNORM,RXNNAME,RXNVER)="" 118 . ; End if/else block 119 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM 120 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME 121 . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER 122 . ; 123 . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5) 124 . D DOSE^PSS50(MEDIEN,,,,,"DOSE") 125 . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) 126 . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901) 127 . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2) 128 . ; Units, concentration, etc, come from another call 129 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit 130 . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters 131 . ; NDF Entry IEN, and VA Product IEN 132 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") 133 . ; These have been collected above. 134 . N CONCDATA 135 . ; If a drug was not matched to NDF, then the NDFIEN is gonna be "" 136 . ; and this will crash the call. So... 137 . I NDFIEN="" S CONCDATA="" 138 . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) 139 . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1) 140 . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3) 141 . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4) 142 . S @MAP@("MEDQUANTITYVALUE")=MED(7) 143 . ; Oddly, there is no easy place to find the dispense unit. 144 . ; It's not included in the original call, so we have to go to the drug file. 145 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") 146 . ; Node 14.5 is the Dispense Unit 147 . D DATA^PSS50(MEDIEN,,,,,"QTY") 148 . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) 149 . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) 150 . ; 151 . ; --- START OF DIRECTIONS --- 152 . ; Sig data not in any API :-( Oh yes, you can get the whole thing, but... 153 . ; we want the compoenents. 154 . ; It's in node 6 of ^PSRX(IEN) 155 . ; So, here we go again 156 . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE 157 . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4) 158 . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE 159 . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^ 160 . ; 161 . N DIRNUM S DIRNUM=0 ; Sigline number 162 . S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS 163 . F S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM="" D 164 . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT 165 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components. 166 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05. 167 . . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0) 168 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9) 169 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1) 170 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT") 171 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient 172 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient 173 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient 174 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01) 175 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8) 176 . . ; Invervals... again another call. 177 . . ; In the wisdom of the original programmers, the schedule is a free text field 178 . . ; However, it gets translated by a call to the administration schedule file 179 . . ; to see if that schedule exists. 180 . . ; That's the same thing I am going to do. 181 . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ). 182 . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO-- 183 . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in. 184 . . ; So... 185 . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE") 186 . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE") 187 . . N INTERVAL 188 . . I $P(SCHEDATA(0),U)=-1 S INTERVAL="" 189 . . E D 190 . . . N SUB S SUB=$O(SCHEDATA(0)) 191 . . . S INTERVAL=SCHEDATA(SUB,2) 192 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL 193 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute" 194 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5) 195 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")="" 196 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN" 197 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" 198 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")="" 199 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")="" 200 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")="" 201 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")="" 202 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")="" 203 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")="" 204 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" 205 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM 206 . . N DIRMOD S DIRMOD=$P(SIGDATA,U,6) 207 . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"") 208 . ; 209 . ; --- END OF DIRECTIONS --- 210 . ; 211 . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE" 212 . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0)) 213 . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command" 214 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0)) 215 . S @MAP@("MEDRFNO")=MED(9) 216 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED")) 217 . K @RESULT 218 . D MAP^C0CXPATH(MINXML,MAP,RESULT) 219 . ; MAPPING DIRECTIONS 220 . N DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 221 . N DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 222 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 223 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions") 224 . ; N MDZ1,MDZNA 225 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS 226 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION 227 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1)) 228 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2) 229 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication") 230 . I MEDCOUNT=1 D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 231 . E D INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML 232 N MEDTMP,MEDI 233 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 234 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 235 . W "MEDICATION MISSING ",! 236 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 237 Q 238 ;
Note:
See TracChangeset
for help on using the changeset viewer.
