Changeset 118 for ccr/trunk/p
- Timestamp:
- Aug 29, 2008, 6:11:36 PM (16 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/CCRMEDS.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/CCRMEDS.m
r103 r118 1 CCRMEDS ; WV/CCDCCR/SMH,CJE,GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08 2 ;;0.1;CCDCCR;;JUL 16,2008; 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(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 24 ; 25 ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 26 ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE 27 ; 28 ; MEDS is return array from RPC. 29 ; MAP is a mapping variable map (store result) for each med 30 ; MED is holds each array element from MEDS(J), one medicine 31 ; J is a counter. 32 ; 33 ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all 34 ; med data available. 35 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf 36 ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS). 37 38 N MEDS,MAP 39 K ^TMP($J) 40 D RX^PSO52API(DFN,"CCDCCR") 41 M MEDS=^TMP($J,"CCDCCR",DFN) 42 ; @(0) contains the number of meds. 43 ; If there are no meds (@(0)=0), we quit. 44 I 'MEDS(0) S @OUTXML@(0)=0 QUIT 45 I DEBUG ZWR MEDS 46 N RXIEN S RXIEN=0 47 F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="" D ; FOR EACH MEDICATION IN THE LIST 48 . I DEBUG W "RXIEN IS ",RXIEN,! 49 . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",J)) 50 . K @MAP 51 . I DEBUG W "MAP= ",MAP,! 52 . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM 53 . S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number 54 . S @MAP@("MEDISSUEDATETXT")="Issue Date" 55 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U)) 56 . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date" 57 . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U)) 58 . S @MAP@("MEDRXNOTXT")="Prescription Number" 59 . S @MAP@("MEDRXNO")=MED(.01) 60 . S @MAP@("MEDTYPETEXT")="Medication" 61 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 62 . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2) 63 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U) 64 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2) 65 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27) 66 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC" 67 . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none" 68 . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5) 69 . N MEDIEN S MEDIEN=$P(MED(6),U) 70 . D DOSE^PSS50(MEDIEN,,,,,"DOSE") 71 . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) 72 . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901) 73 . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2) 74 . S @MAP@("MEDFORMTEXT")=$P(MED("OI"),U,4) 75 . S @MAP@("MEDCONCVALUE") 76 . S @MAP@("MEDCONCUNIT") 77 . S @MAP@("MEDSIZETEXT") 78 . S @MAP@("MEDQUANTITYVALUE") 79 . S @MAP@("MEDQUANTITYUNIT") 80 . S @MAP@("MEDDIRECTIONDESCRIPTIONTEXT") 81 . S @MAP@("MEDDOSEINDICATOR") 82 . S @MAP@("MEDDELIVERYMETHOD") 83 . S @MAP@("MEDDOSEVALUE") 84 . S @MAP@("MEDDOSEUNIT") 85 . S @MAP@("MEDRATEVALUE") 86 . S @MAP@("MEDRATEUNIT") 87 . S @MAP@("MEDVEHICLETEXT") 88 . S @MAP@("MEDDIRECTIONROUTETEXT") 89 . S @MAP@("MEDFREQUENCYVALUE") 90 . S @MAP@("MEDFREQUENCYUNIT") 91 . S @MAP@("MEDINTERVALVALUE") 92 . S @MAP@("MEDINTERVALUNIT") 93 . S @MAP@("MEDDURATIONVALUE") 94 . S @MAP@("MEDDURATIONUNIT") 95 . S @MAP@("MEDPRNFLAG") 96 . S @MAP@("MEDPROBLEMOBJECTID")="" 97 . S @MAP@("MEDPROBLEMDESCRIPTION")="" 98 . S @MAP@("MEDPROBLEMCODEVALUE")="" 99 . S @MAP@("MEDPROBLEMCODINGSYSTEM")="" 100 . S @MAP@("MEDPROBLEMCODINGVERSION")="" 101 . S @MAP@("MEDPROBLEMSOURCEACTORID")="" 102 . S @MAP@("MEDSTOPINDICATOR") 103 . S @MAP@("MEDDIRSEQ") 104 . S @MAP@("MEDMULDIRMOD") 105 . S @MAP@("MEDPTINSTRUCTIONS") 106 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS") 107 . S @MAP@("MEDRFNO") 108 . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"RESULT",J)) 109 . K @RESULT 110 . D MAP^GPLXPATH(INXML,MAP,RESULT) 111 . D:J=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy 112 . D:J>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 113 N MEDTMP,MEDI 114 D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 115 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 116 . W "MEDICATION MISSING ",! 117 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 118 Q 119 ; 1 CCRMEDS ; WV/CCDCCR/SMH,CJE,GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08 2 ;;0.1;CCDCCR;;JUL 16,2008; 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(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE 24 ; 25 ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 26 ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE 27 ; 28 ; MEDS is return array from RPC. 29 ; MAP is a mapping variable map (store result) for each med 30 ; MED is holds each array element from MEDS(J), one medicine 31 ; J is a counter. 32 ; 33 ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all 34 ; med data available. 35 ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf 36 ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS). 37 38 N MEDS,MAP 39 K ^TMP($J) 40 D RX^PSO52API(DFN,"CCDCCR") 41 M MEDS=^TMP($J,"CCDCCR",DFN) 42 ; @(0) contains the number of meds or -1^NO DATA FOUND 43 ; If it is -1, we quit. 44 I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT 45 I DEBUG ZWR MEDS 46 N RXIEN S RXIEN=0 47 F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="" D ; FOR EACH MEDICATION IN THE LIST 48 . I DEBUG W "RXIEN IS ",RXIEN,! 49 . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",J)) 50 . K @MAP 51 . I DEBUG W "MAP= ",MAP,! 52 . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM 53 . S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number 54 . S @MAP@("MEDISSUEDATETXT")="Issue Date" 55 . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U)) 56 . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date" 57 . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U)) 58 . S @MAP@("MEDRXNOTXT")="Prescription Number" 59 . S @MAP@("MEDRXNO")=MED(.01) 60 . S @MAP@("MEDTYPETEXT")="Medication" 61 . S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses 62 . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2) 63 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U) 64 . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2) 65 . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27) 66 . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC" 67 . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none" 68 . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5) 69 . N MEDIEN S MEDIEN=$P(MED(6),U) 70 . D DOSE^PSS50(MEDIEN,,,,,"DOSE") 71 . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN) 72 . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901) 73 . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2) 74 . ; Units, concentration, etc, come from another call 75 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit 76 . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters 77 . ; NDF Entry IEN, and VA Product Name 78 . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT") 79 . ; Documented in the same manual. 80 . N IEN S IEN=^PSDRUG($P(MED(6),U)) 81 . D NDF^PSS50(IEN,,,,,"CONC") 82 . N NDFDATA M NDFDATA=^TMP($J,"CONC",IEN) 83 . N NDFIEN S NDFIEN=$P(NDFDATA(20),U) 84 . N VAPROD S VAPROD=$P(NDFDATA(22),U) 85 . N CONCDATA S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD) 86 . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1) 87 . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3) 88 . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4) 89 . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2) 90 . S @MAP@("MEDQUANTITYVALUE")=MED(7) 91 . ; Oddly, there is no easy place to find the dispense unit. 92 . ; It's not included in the original call, so we have to go to the drug file. 93 . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT") 94 . ; Node 14.5 is the Dispense Unit 95 . D DATA^PSS50(IEN,,,,,"QTY") 96 . N QTYDATA M QTYDATA=^TMP($J,"QTY",IEN) 97 . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5) 98 . S @MAP@("MEDDIRECTIONDESCRIPTIONTEXT")="" 99 . S @MAP@("MEDDOSEINDICATOR") 100 . S @MAP@("MEDDELIVERYMETHOD") 101 . S @MAP@("MEDDOSEVALUE") 102 . S @MAP@("MEDDOSEUNIT") 103 . S @MAP@("MEDRATEVALUE") 104 . S @MAP@("MEDRATEUNIT") 105 . S @MAP@("MEDVEHICLETEXT") 106 . S @MAP@("MEDDIRECTIONROUTETEXT") 107 . S @MAP@("MEDFREQUENCYVALUE") 108 . S @MAP@("MEDFREQUENCYUNIT") 109 . S @MAP@("MEDINTERVALVALUE") 110 . S @MAP@("MEDINTERVALUNIT") 111 . S @MAP@("MEDDURATIONVALUE") 112 . S @MAP@("MEDDURATIONUNIT") 113 . S @MAP@("MEDPRNFLAG") 114 . S @MAP@("MEDPROBLEMOBJECTID")="" 115 . S @MAP@("MEDPROBLEMDESCRIPTION")="" 116 . S @MAP@("MEDPROBLEMCODEVALUE")="" 117 . S @MAP@("MEDPROBLEMCODINGSYSTEM")="" 118 . S @MAP@("MEDPROBLEMCODINGVERSION")="" 119 . S @MAP@("MEDPROBLEMSOURCEACTORID")="" 120 . S @MAP@("MEDSTOPINDICATOR") 121 . S @MAP@("MEDDIRSEQ") 122 . S @MAP@("MEDMULDIRMOD") 123 . S @MAP@("MEDPTINSTRUCTIONS") 124 . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS") 125 . S @MAP@("MEDRFNO")=MED(9) 126 . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"RESULT",J)) 127 . K @RESULT 128 . D MAP^GPLXPATH(INXML,MAP,RESULT) 129 . D:J=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy 130 . D:J>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML 131 N MEDTMP,MEDI 132 D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS 133 I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 134 . W "MEDICATION MISSING ",! 135 . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! 136 Q 137 ;
Note:
See TracChangeset
for help on using the changeset viewer.
