Index: /ccr/trunk/p/CCRMEDS.m =================================================================== --- /ccr/trunk/p/CCRMEDS.m (revision 117) +++ /ccr/trunk/p/CCRMEDS.m (revision 118) @@ -1,119 +1,137 @@ -CCRMEDS ; WV/CCDCCR/SMH,CJE,GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08 - ;;0.1;CCDCCR;;JUL 16,2008; - ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU - ; General Public License See attached copy of the License. - ; - ; This program is free software; you can redistribute it and/or modify - ; it under the terms of the GNU General Public License as published by - ; the Free Software Foundation; either version 2 of the License, or - ; (at your option) any later version. - ; - ; This program is distributed in the hope that it will be useful, - ; but WITHOUT ANY WARRANTY; without even the implied warranty of - ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ; GNU General Public License for more details. - ; - ; You should have received a copy of the GNU General Public License along - ; with this program; if not, write to the Free Software Foundation, Inc., - ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - W "NO ENTRY FROM TOP",! - Q - ; -EXTRACT(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE - ; - ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED - ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE - ; - ; MEDS is return array from RPC. - ; MAP is a mapping variable map (store result) for each med - ; MED is holds each array element from MEDS(J), one medicine - ; J is a counter. - ; - ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all - ; med data available. - ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf - ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS). - - N MEDS,MAP - K ^TMP($J) - D RX^PSO52API(DFN,"CCDCCR") - M MEDS=^TMP($J,"CCDCCR",DFN) - ; @(0) contains the number of meds. - ; If there are no meds (@(0)=0), we quit. - I 'MEDS(0) S @OUTXML@(0)=0 QUIT - I DEBUG ZWR MEDS - N RXIEN S RXIEN=0 - F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="" D ; FOR EACH MEDICATION IN THE LIST - . I DEBUG W "RXIEN IS ",RXIEN,! - . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",J)) - . K @MAP - . I DEBUG W "MAP= ",MAP,! - . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM - . S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number - . S @MAP@("MEDISSUEDATETXT")="Issue Date" - . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U)) - . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date" - . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U)) - . S @MAP@("MEDRXNOTXT")="Prescription Number" - . S @MAP@("MEDRXNO")=MED(.01) - . S @MAP@("MEDTYPETEXT")="Medication" - . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses - . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2) - . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U) - . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2) - . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27) - . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC" - . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none" - . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5) - . N MEDIEN S MEDIEN=$P(MED(6),U) - . D DOSE^PSS50(MEDIEN,,,,,"DOSE") - . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) - . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901) - . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2) - . S @MAP@("MEDFORMTEXT")=$P(MED("OI"),U,4) - . S @MAP@("MEDCONCVALUE") - . S @MAP@("MEDCONCUNIT") - . S @MAP@("MEDSIZETEXT") - . S @MAP@("MEDQUANTITYVALUE") - . S @MAP@("MEDQUANTITYUNIT") - . S @MAP@("MEDDIRECTIONDESCRIPTIONTEXT") - . S @MAP@("MEDDOSEINDICATOR") - . S @MAP@("MEDDELIVERYMETHOD") - . S @MAP@("MEDDOSEVALUE") - . S @MAP@("MEDDOSEUNIT") - . S @MAP@("MEDRATEVALUE") - . S @MAP@("MEDRATEUNIT") - . S @MAP@("MEDVEHICLETEXT") - . S @MAP@("MEDDIRECTIONROUTETEXT") - . S @MAP@("MEDFREQUENCYVALUE") - . S @MAP@("MEDFREQUENCYUNIT") - . S @MAP@("MEDINTERVALVALUE") - . S @MAP@("MEDINTERVALUNIT") - . S @MAP@("MEDDURATIONVALUE") - . S @MAP@("MEDDURATIONUNIT") - . S @MAP@("MEDPRNFLAG") - . S @MAP@("MEDPROBLEMOBJECTID")="" - . S @MAP@("MEDPROBLEMDESCRIPTION")="" - . S @MAP@("MEDPROBLEMCODEVALUE")="" - . S @MAP@("MEDPROBLEMCODINGSYSTEM")="" - . S @MAP@("MEDPROBLEMCODINGVERSION")="" - . S @MAP@("MEDPROBLEMSOURCEACTORID")="" - . S @MAP@("MEDSTOPINDICATOR") - . S @MAP@("MEDDIRSEQ") - . S @MAP@("MEDMULDIRMOD") - . S @MAP@("MEDPTINSTRUCTIONS") - . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS") - . S @MAP@("MEDRFNO") - . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"RESULT",J)) - . K @RESULT - . D MAP^GPLXPATH(INXML,MAP,RESULT) - . D:J=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy - . D:J>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML - N MEDTMP,MEDI - D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS - I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ - . W "MEDICATION MISSING ",! - . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! - Q - ; +CCRMEDS ; WV/CCDCCR/SMH,CJE,GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08 + ;;0.1;CCDCCR;;JUL 16,2008; + ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU + ; General Public License See attached copy of the License. + ; + ; This program is free software; you can redistribute it and/or modify + ; it under the terms of the GNU General Public License as published by + ; the Free Software Foundation; either version 2 of the License, or + ; (at your option) any later version. + ; + ; This program is distributed in the hope that it will be useful, + ; but WITHOUT ANY WARRANTY; without even the implied warranty of + ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ; GNU General Public License for more details. + ; + ; You should have received a copy of the GNU General Public License along + ; with this program; if not, write to the Free Software Foundation, Inc., + ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + W "NO ENTRY FROM TOP",! + Q + ; +EXTRACT(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE + ; + ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED + ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE + ; + ; MEDS is return array from RPC. + ; MAP is a mapping variable map (store result) for each med + ; MED is holds each array element from MEDS(J), one medicine + ; J is a counter. + ; + ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all + ; med data available. + ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf + ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS). + + N MEDS,MAP + K ^TMP($J) + D RX^PSO52API(DFN,"CCDCCR") + M MEDS=^TMP($J,"CCDCCR",DFN) + ; @(0) contains the number of meds or -1^NO DATA FOUND + ; If it is -1, we quit. + I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT + I DEBUG ZWR MEDS + N RXIEN S RXIEN=0 + F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="" D ; FOR EACH MEDICATION IN THE LIST + . I DEBUG W "RXIEN IS ",RXIEN,! + . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",J)) + . K @MAP + . I DEBUG W "MAP= ",MAP,! + . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM + . S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number + . S @MAP@("MEDISSUEDATETXT")="Issue Date" + . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U)) + . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date" + . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U)) + . S @MAP@("MEDRXNOTXT")="Prescription Number" + . S @MAP@("MEDRXNO")=MED(.01) + . S @MAP@("MEDTYPETEXT")="Medication" + . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses + . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2) + . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U) + . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2) + . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27) + . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC" + . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none" + . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5) + . N MEDIEN S MEDIEN=$P(MED(6),U) + . D DOSE^PSS50(MEDIEN,,,,,"DOSE") + . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) + . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901) + . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2) + . ; Units, concentration, etc, come from another call + . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit + . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters + . ; NDF Entry IEN, and VA Product Name + . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") + . ; Documented in the same manual. + . N IEN S IEN=^PSDRUG($P(MED(6),U)) + . D NDF^PSS50(IEN,,,,,"CONC") + . N NDFDATA M NDFDATA=^TMP($J,"CONC",IEN) + . N NDFIEN S NDFIEN=$P(NDFDATA(20),U) + . N VAPROD S VAPROD=$P(NDFDATA(22),U) + . N CONCDATA S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) + . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1) + . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3) + . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4) + . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2) + . S @MAP@("MEDQUANTITYVALUE")=MED(7) + . ; Oddly, there is no easy place to find the dispense unit. + . ; It's not included in the original call, so we have to go to the drug file. + . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") + . ; Node 14.5 is the Dispense Unit + . D DATA^PSS50(IEN,,,,,"QTY") + . N QTYDATA M QTYDATA=^TMP($J,"QTY",IEN) + . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) + . S @MAP@("MEDDIRECTIONDESCRIPTIONTEXT")="" + . S @MAP@("MEDDOSEINDICATOR") + . S @MAP@("MEDDELIVERYMETHOD") + . S @MAP@("MEDDOSEVALUE") + . S @MAP@("MEDDOSEUNIT") + . S @MAP@("MEDRATEVALUE") + . S @MAP@("MEDRATEUNIT") + . S @MAP@("MEDVEHICLETEXT") + . S @MAP@("MEDDIRECTIONROUTETEXT") + . S @MAP@("MEDFREQUENCYVALUE") + . S @MAP@("MEDFREQUENCYUNIT") + . S @MAP@("MEDINTERVALVALUE") + . S @MAP@("MEDINTERVALUNIT") + . S @MAP@("MEDDURATIONVALUE") + . S @MAP@("MEDDURATIONUNIT") + . S @MAP@("MEDPRNFLAG") + . S @MAP@("MEDPROBLEMOBJECTID")="" + . S @MAP@("MEDPROBLEMDESCRIPTION")="" + . S @MAP@("MEDPROBLEMCODEVALUE")="" + . S @MAP@("MEDPROBLEMCODINGSYSTEM")="" + . S @MAP@("MEDPROBLEMCODINGVERSION")="" + . S @MAP@("MEDPROBLEMSOURCEACTORID")="" + . S @MAP@("MEDSTOPINDICATOR") + . S @MAP@("MEDDIRSEQ") + . S @MAP@("MEDMULDIRMOD") + . S @MAP@("MEDPTINSTRUCTIONS") + . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS") + . S @MAP@("MEDRFNO")=MED(9) + . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"RESULT",J)) + . K @RESULT + . D MAP^GPLXPATH(INXML,MAP,RESULT) + . D:J=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy + . D:J>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML + N MEDTMP,MEDI + D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS + I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ + . W "MEDICATION MISSING ",! + . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! + Q + ;