Changeset 1544 for ccr/trunk/p/C0CNMED4.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/C0CNMED4.m
-
Property svn:mergeinfo
set to (toggle deleted branches)
/ccr/branches/ohum/p/C0CNMED4.m merged eligible /ccr/branches/ohum/o-old/p/C0CNMED4.m 1290 /ccr/branches/ohum/p/p/C0CNMED4.m 1287-1289
r1205 r1544 1 C0CMED4 ; WV/CCDCCR/SMH/gpl - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08 2 ;;0.1;CCDCCR;;; 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 ; 23 EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 24 ; 25 ; this routine has be adapted to retrieve meds from GET^NHINV by gpl 6/2011 26 ; 27 ; MINXML is the Input XML Template, passed by name 28 ; DFN is Patient IEN 29 ; OUTXML is the resultant XML. 30 ; 31 ; MEDS is return array from API. 32 ; MED is holds each array element from MEDS, one medicine 33 ; MAP is a mapping variable map (store result) for each med 34 ; 35 ; Inpatient Meds will be extracted using this routine and and the one following. 36 ; Inpatient Meds Unit Dose is going to be C0CMED4 37 ; Inpatient Meds IVs is going to be C0CMED5 38 ; 39 ; We will use two Pharmacy ReEnginnering API's: 40 ; PSS431^PSS55(DFN,PO,PSDATE,PEDATE,LIST) - provides most info 41 ; PSS432^PSS55(DFN,PO,LIST) - provides schedule info 42 ; For more information, see the PRE documentation at: 43 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Inpatient_Med/phar_1_api_r0807.pdf 44 ; 45 ; Med data is stored in Unit Dose multiple of file 55, pharmacy patient 46 ; 47 N MEDS,MAP 48 ;K ^TMP($J) 49 ;D PSS431^PSS55(DFN,,,,"UD") ; Output is in ^TMP($J,"UD",*) 50 ;I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT ; No Meds - Quit 51 ;; Otherwise, we go on... 52 D EN^C0CNHIN(.MEDS,DFN,"MED;") ; gpl get the NHIN Array of meds 53 I '$D(MEDS) Q ; no meds 54 N ZI S ZI="" 55 N ZCOUNT S ZCOUNT=0 56 F S ZI=$O(MEDS("med",ZI)) Q:ZI="" D ; for each returned med 57 . I $G(MEDS("med",ZI,"vaType@value"))="I" S ZCOUNT=ZCOUNT+1 58 IF ZCOUNT=0 Q ; no inpatient meds 59 ;M MEDS=^TMP($J,"UD") 60 I DEBUG ZWR MEDS 61 S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) 62 ;N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array 63 N I S I=0 64 F S I=$O(MEDS("med",I)) Q:'I D ; For each medication 65 . N MED M MED=MEDS("med",I) 66 . I $G(MED("vaType@value"))'="I" Q ; not inpatient 67 . S MEDCOUNT=MEDCOUNT+1 68 . S @MEDMAP@(0)=MEDCOUNT ; Update MedMap array counter 69 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT)) 70 . ;N RXIEN S RXIEN=MED(.01) ; Order Number 71 . N RXIEN S RXIEN=$G(MED("orderID@value")) ; ien of the med 72 . I DEBUG W "RXIEN IS ",RXIEN,! 73 . I DEBUG W "MAP= ",MAP,! 74 . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN 75 . S @MAP@("MEDISSUEDATETXT")="Order Date" 76 . ;S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT") 77 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($G(MED("start@value")),"DT") 78 . S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient 79 . S @MAP@("MEDLASTFILLDATE")="" ; For Outpatient 80 . S @MAP@("MEDRXNOTXT")="" ; For Outpatient 81 . S @MAP@("MEDRXNO")="" ; For Outpatient 82 . S @MAP@("MEDTYPETEXT")="Medication" 83 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 84 . ;S @MAP@("MEDSTATUSTEXT")="ACTIVE" 85 . N C0CMST S C0CMST=$G(MED("vaStatus@value")) ; need to filter status 86 . I C0CMST="EXPIRED" S C0CMST="Prior History No Longer Active" 87 . I C0CMST="ACTIVE" S C0CMST="Active" ; 88 . S @MAP@("MEDSTATUSTEXT")=C0CMST 89 . ;S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U) 90 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$G(MED("orderingProvider@code")) 91 . ;S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01) 92 . S @MAP@("MEDPRODUCTNAMETEXT")=$G(MED("name@value")) 93 . ; NDC is field 31 in the drug file. 94 . ; The actual drug entry in the drug file is not necessarily supplied. 95 . ; It' node 1, internal form. 96 . ;N MEDIEN S MEDIEN=MED(1,"I") 97 . ;S @MAP@("MEDPRODUCTNAMECODEVALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"") 98 . N ZVUID S ZVUID=$G(MED("products.product.vaProduct@vuid")) ; VUID 99 . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION 100 . D ; 101 . . S ZC=$$CODE^C0CUTIL(ZVUID) 102 . . S ZCD=$P(ZC,"^",1) ; CODE TO USE 103 . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID 104 . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION 105 . ;N ZRXNORM S ZRXNORM="" 106 . ;S ZRXNORM=$$RXNCUI3^C0PLKUP(ZVUID) 107 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=ZCD 108 . ;S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"") 109 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=ZCDS 110 . ;S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"") 111 . S @MAP@("MEDPRODUCTNAMECODEVERSION")=ZCDSV 112 . S @MAP@("MEDBRANDNAMETEXT")="" 113 . S @MAP@("MEDPRODUCTNAMETEXT")=$G(MED("name@value"))_" "_ZCDS_": "_ZCD 114 . ;I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE") 115 . ;I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) 116 . ;S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"") 117 . S @MAP@("MEDSTRENGTHVALUE")=$G(MED("doses.dose@dose")) 118 . ;S @MAP@("MEDSTRENGTHUNIT")=$S($P(DOSEDATA(902),U,2),1:"") 119 . S @MAP@("MEDSTRENGTHUNIT")=$G(MED("doses.dose@units")) 120 . ; Units, concentration, etc, come from another call 121 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit 122 . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters 123 . ; NDF Entry IEN, and VA Product Name 124 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") 125 . ; Documented in the same manual. 126 . ;N NDFDATA,CONCDATA 127 . ;I $L(MEDIEN) D 128 . ;. D NDF^PSS50(MEDIEN,,,,,"CONC") 129 . ;. M NDFDATA=^TMP($J,"CONC",MEDIEN) 130 . ;. N NDFIEN S NDFIEN=$P(NDFDATA(20),U) 131 . ;. N VAPROD S VAPROD=$P(NDFDATA(22),U) 132 . ;. ; If a drug was not matched to NDF, then the NDFIEN is gonna be "" 133 . ;. ; and this will crash the call. So... 134 . ;. I NDFIEN="" S CONCDATA="" 135 . ;. E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) 136 . ;E S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors. 137 . ;S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"") 138 . S @MAP@("MEDFORMTEXT")=$G(MED("form@value")) 139 . ;S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"") 140 . S @MAP@("MEDCONCVALUE")=$G(MED("doses.dose@dose")) 141 . ;S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"") 142 . S @MAP@("MEDCONCUNIT")=$G(MED("doses.does@units")) 143 . ;S @MAP@("MEDQUANTITYVALUE")="" ; not provided for in Non-VA meds. 144 . S @MAP@("MEDQUANTITYVALUE")=$G(MED("doses.dose@unitsPerDose")) ; 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 . ;I $L(MEDIEN) D 150 . ;. D DATA^PSS50(MEDIEN,,,,,"QTY") 151 . ;. N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) 152 . ;. S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) 153 . ;E S @MAP@("MEDQUANTITYUNIT")="" 154 . S @MAP@("MEDQUANTITYUNIT")=$G(MED("dose.dose@unitsPerDose")) 155 . ; 156 . ; --- START OF DIRECTIONS --- 157 . ; Dosage is field 2, route is 3, schedule is 4 158 . ; These are all free text fields, and don't point to any files 159 . ; For that reason, I will use the field I never used before: 160 . ; MEDDIRECTIONDESCRIPTIONTEXT 161 . ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E") 162 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=$G(MED("sig")) 163 . ; $G(MED("products.product.vaProduct@name")) 164 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4" ; means look in description text. See E2369-05. 165 . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")="" 166 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")="" 167 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")="" 168 . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")="" 169 . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")="" 170 . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")="" 171 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")="" 172 . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")="" 173 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")="" 174 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")="" 175 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")="" 176 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")="" 177 . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")="" 178 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")="" 179 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")="" 180 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")="" 181 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")="" 182 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")="" 183 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")="" 184 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")="" 185 . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 186 . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")="" 187 . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")="" 188 . ; 189 . ; --- END OF DIRECTIONS --- 190 . ; 191 . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105" 192 . ;S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field 193 . S @MAP@("MEDPTINSTRUCTIONS")="" 194 . ;S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field 195 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")="" 196 . S @MAP@("MEDRFNO")="" 197 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED")) 198 . K @RESULT 199 . D MAP^C0CXPATH(MINXML,MAP,RESULT) 200 . ; D PARY^C0CXPATH(RESULT) 201 . ; MAPPING DIRECTIONS 202 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 203 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 204 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 205 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions") 206 . ; N MDZ1,MDZNA 207 . N DIRCNT S DIRCNT=1 ; THERE ARE ALWAYS DIRECTIONS 208 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS 209 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION 210 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1)) 211 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2) 212 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication") 213 . D:MEDCOUNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 214 . D:MEDCOUNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 215 N MEDTMP,MEDI 216 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 217 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 218 . W "MEDICATION MISSING ",! 219 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 220 Q 221 ; 1 C0CNMED4 ; WV/CCDCCR/SMH/gpl - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08 ; 5/10/12 2:54pm 2 ;;1.2;C0C;;May 11, 2012;Build 47 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 ; 23 EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 24 ; 25 ; this routine has be adapted to retrieve meds from GET^NHINV by gpl 6/2011 26 ; 27 ; MINXML is the Input XML Template, passed by name 28 ; DFN is Patient IEN 29 ; OUTXML is the resultant XML. 30 ; 31 ; MEDS is return array from API. 32 ; MED is holds each array element from MEDS, one medicine 33 ; MAP is a mapping variable map (store result) for each med 34 ; 35 ; Inpatient Meds will be extracted using this routine and and the one following. 36 ; Inpatient Meds Unit Dose is going to be C0CMED4 37 ; Inpatient Meds IVs is going to be C0CMED5 38 ; 39 ; We will use two Pharmacy ReEnginnering API's: 40 ; PSS431^PSS55(DFN,PO,PSDATE,PEDATE,LIST) - provides most info 41 ; PSS432^PSS55(DFN,PO,LIST) - provides schedule info 42 ; For more information, see the PRE documentation at: 43 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Inpatient_Med/phar_1_api_r0807.pdf 44 ; 45 ; Med data is stored in Unit Dose multiple of file 55, pharmacy patient 46 ; 47 N MEDS,MAP 48 ;K ^TMP($J) 49 ;D PSS431^PSS55(DFN,,,,"UD") ; Output is in ^TMP($J,"UD",*) 50 ;I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT ; No Meds - Quit 51 ;; Otherwise, we go on... 52 D EN^C0CNHIN(.MEDS,DFN,"MED;") ; gpl get the NHIN Array of meds 53 I '$D(MEDS) Q ; no meds 54 N ZI S ZI="" 55 N ZCOUNT S ZCOUNT=0 56 F S ZI=$O(MEDS("med",ZI)) Q:ZI="" D ; for each returned med 57 . I $G(MEDS("med",ZI,"vaType@value"))="I" S ZCOUNT=ZCOUNT+1 58 IF ZCOUNT=0 Q ; no inpatient meds 59 ;M MEDS=^TMP($J,"UD") 60 I DEBUG ZWR MEDS 61 S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) 62 ;N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array 63 S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING") ;SETTING FLAG 64 N I S I=0 65 F S I=$O(MEDS("med",I)) Q:'I D ; For each medication 66 . ;OHUM/RUT 3120507 ;STATUS VALIDATION FOR INPATIENT 67 . I ($P(C0CMFLAG,"^",1)'=1) D 68 . . I ($P(C0CMFLAG,"^",3)=1)&(MEDS("med",I,"vaStatus@value")'="ACTIVE") D 69 . . . K MEDS("med",I) Q 70 . . I ($P(C0CMFLAG,"^",4)=1)&(MEDS("med",I,"vaStatus@value")'="PENDING") D 71 . . . K MEDS("med",I) Q 72 . ;OHUM/RUT 73 . N MED M MED=MEDS("med",I) 74 . I $G(MED("vaType@value"))'="I" Q ; not inpatient 75 . S MEDCOUNT=MEDCOUNT+1 76 . S @MEDMAP@(0)=MEDCOUNT ; Update MedMap array counter 77 . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT)) 78 . ;N RXIEN S RXIEN=MED(.01) ; Order Number 79 . N RXIEN S RXIEN=$G(MED("orderID@value")) ; ien of the med 80 . I DEBUG W "RXIEN IS ",RXIEN,! 81 . I DEBUG W "MAP= ",MAP,! 82 . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN 83 . S @MAP@("MEDISSUEDATETXT")="Order Date" 84 . ;S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT") 85 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($G(MED("start@value")),"DT") 86 . S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient 87 . S @MAP@("MEDLASTFILLDATE")="" ; For Outpatient 88 . S @MAP@("MEDRXNOTXT")="" ; For Outpatient 89 . S @MAP@("MEDRXNO")="" ; For Outpatient 90 . S @MAP@("MEDTYPETEXT")="Medication" 91 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 92 . ;S @MAP@("MEDSTATUSTEXT")="ACTIVE" 93 . N C0CMST S C0CMST=$G(MED("vaStatus@value")) ; need to filter status 94 . I C0CMST="EXPIRED" S C0CMST="Prior History No Longer Active" 95 . I C0CMST="ACTIVE" S C0CMST="Active" ; 96 . S @MAP@("MEDSTATUSTEXT")=C0CMST 97 . ;S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U) 98 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$G(MED("orderingProvider@code")) 99 . ;S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01) 100 . S @MAP@("MEDPRODUCTNAMETEXT")=$G(MED("name@value")) 101 . ; NDC is field 31 in the drug file. 102 . ; The actual drug entry in the drug file is not necessarily supplied. 103 . ; It' node 1, internal form. 104 . ;N MEDIEN S MEDIEN=MED(1,"I") 105 . ;S @MAP@("MEDPRODUCTNAMECODEVALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"") 106 . N ZVUID S ZVUID=$G(MED("products.product.vaProduct@vuid")) ; VUID 107 . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION 108 . D ; 109 . . S ZC=$$CODE^C0CUTIL(ZVUID) 110 . . S ZCD=$P(ZC,"^",1) ; CODE TO USE 111 . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID 112 . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION 113 . ;N ZRXNORM S ZRXNORM="" 114 . ;S ZRXNORM=$$RXNCUI3^C0PLKUP(ZVUID) 115 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=ZCD 116 . ;S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"") 117 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=ZCDS 118 . ;S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"") 119 . S @MAP@("MEDPRODUCTNAMECODEVERSION")=ZCDSV 120 . S @MAP@("MEDBRANDNAMETEXT")="" 121 . S @MAP@("MEDPRODUCTNAMETEXT")=$G(MED("name@value"))_" "_ZCDS_": "_ZCD 122 . ;I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE") 123 . ;I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) 124 . ;S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"") 125 . S @MAP@("MEDSTRENGTHVALUE")=$G(MED("doses.dose@dose")) 126 . ;S @MAP@("MEDSTRENGTHUNIT")=$S($P(DOSEDATA(902),U,2),1:"") 127 . S @MAP@("MEDSTRENGTHUNIT")=$G(MED("doses.dose@units")) 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 Name 132 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") 133 . ; Documented in the same manual. 134 . ;N NDFDATA,CONCDATA 135 . ;I $L(MEDIEN) D 136 . ;. D NDF^PSS50(MEDIEN,,,,,"CONC") 137 . ;. M NDFDATA=^TMP($J,"CONC",MEDIEN) 138 . ;. N NDFIEN S NDFIEN=$P(NDFDATA(20),U) 139 . ;. N VAPROD S VAPROD=$P(NDFDATA(22),U) 140 . ;. ; If a drug was not matched to NDF, then the NDFIEN is gonna be "" 141 . ;. ; and this will crash the call. So... 142 . ;. I NDFIEN="" S CONCDATA="" 143 . ;. E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) 144 . ;E S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors. 145 . ;S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"") 146 . S @MAP@("MEDFORMTEXT")=$G(MED("form@value")) 147 . ;S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"") 148 . S @MAP@("MEDCONCVALUE")=$G(MED("doses.dose@dose")) 149 . ;S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"") 150 . S @MAP@("MEDCONCUNIT")=$G(MED("doses.does@units")) 151 . ;S @MAP@("MEDQUANTITYVALUE")="" ; not provided for in Non-VA meds. 152 . S @MAP@("MEDQUANTITYVALUE")=$G(MED("doses.dose@unitsPerDose")) ; 153 . ; Oddly, there is no easy place to find the dispense unit. 154 . ; It's not included in the original call, so we have to go to the drug file. 155 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") 156 . ; Node 14.5 is the Dispense Unit 157 . ;I $L(MEDIEN) D 158 . ;. D DATA^PSS50(MEDIEN,,,,,"QTY") 159 . ;. N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN) 160 . ;. S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) 161 . ;E S @MAP@("MEDQUANTITYUNIT")="" 162 . S @MAP@("MEDQUANTITYUNIT")=$G(MED("dose.dose@unitsPerDose")) 163 . ; 164 . ; --- START OF DIRECTIONS --- 165 . ; Dosage is field 2, route is 3, schedule is 4 166 . ; These are all free text fields, and don't point to any files 167 . ; For that reason, I will use the field I never used before: 168 . ; MEDDIRECTIONDESCRIPTIONTEXT 169 . ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E") 170 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=$G(MED("sig")) 171 . ; $G(MED("products.product.vaProduct@name")) 172 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4" ; means look in description text. See E2369-05. 173 . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")="" 174 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")="" 175 . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")="" 176 . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")="" 177 . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")="" 178 . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")="" 179 . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")="" 180 . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")="" 181 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")="" 182 . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")="" 183 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")="" 184 . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")="" 185 . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")="" 186 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")="" 187 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")="" 188 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")="" 189 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")="" 190 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")="" 191 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")="" 192 . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")="" 193 . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 194 . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")="" 195 . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")="" 196 . ; 197 . ; --- END OF DIRECTIONS --- 198 . ; 199 . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105" 200 . ;S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field 201 . S @MAP@("MEDPTINSTRUCTIONS")="" 202 . ;S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field 203 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")="" 204 . S @MAP@("MEDRFNO")="" 205 . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED")) 206 . K @RESULT 207 . D MAP^C0CXPATH(MINXML,MAP,RESULT) 208 . ; D PARY^C0CXPATH(RESULT) 209 . ; MAPPING DIRECTIONS 210 . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE 211 . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT 212 . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1) 213 . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions") 214 . ; N MDZ1,MDZNA 215 . N DIRCNT S DIRCNT=1 ; THERE ARE ALWAYS DIRECTIONS 216 . I DIRCNT>0 D ; IF THERE ARE DIRCTIONS 217 . . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION 218 . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1)) 219 . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2) 220 . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication") 221 . D:MEDCOUNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy 222 . D:MEDCOUNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 223 N MEDTMP,MEDI 224 D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 225 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 226 . W "MEDICATION MISSING ",! 227 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 228 Q 229 ; -
Property svn:mergeinfo
set to (toggle deleted branches)
Note:
See TracChangeset
for help on using the changeset viewer.