Index: ccr/trunk/p/C0CCCD.m
===================================================================
--- ccr/trunk/p/C0CCCD.m	(revision 415)
+++ ccr/trunk/p/C0CCCD.m	(revision 416)
@@ -151,5 +151,5 @@
     ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
     D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
-    ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
+    ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
     I 'CCD D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
     Q
Index: ccr/trunk/p/C0CCCR.m
===================================================================
--- ccr/trunk/p/C0CCCR.m	(revision 415)
+++ ccr/trunk/p/C0CCCR.m	(revision 416)
@@ -79,5 +79,5 @@
  I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
  I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION
- I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING CCRMEDS SECTION
+ I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING C0CMED SECTION
  S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
  S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
@@ -135,5 +135,5 @@
  ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
  D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
- D PUSH^C0CXPATH(TAB,"EXTRACT;CCRMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
+ D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
  D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
  D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")")
Index: ccr/trunk/p/C0CMED.m
===================================================================
--- ccr/trunk/p/C0CMED.m	(revision 416)
+++ ccr/trunk/p/C0CMED.m	(revision 416)
@@ -0,0 +1,208 @@
+C0CMED ; CCDCCR/GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08  14:33
+ ;;0.1;CCDCCR;;JUL 16,2008;
+ ;Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel.
+ ;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(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+ ;
+ ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+ ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
+ ;
+ N HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS
+ N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED
+ ; OUTPATIENT ACTIVE MEDS ARE PROCESSED IN EXTRACT^C0CMED1
+ ; OUTPATIENT PENDING MEDS IN EXTRACT^C0CMED2
+ ; NON-VA MEDS IN EXTRACT^C0CMED3
+ ; INPATIENT MEDS IN EXTRACT^C0CMED4
+ ; ALL OTHERS HERE
+ S MEDTVMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
+ K @MEDTVMAP ; CLEAR VARIABLE ARRAY
+ S @MEDTVMAP@(0)=0 ; INITIALIZE NUMBER OF MEDS PROCESSED
+ S MEDTARYTMP=$NA(^TMP("C0CCCR",$J,"MEDARYTMP"))
+ K @MEDTARYTMP ; KILL XML ARRAY
+ I $G(DUZ("AG"))="I" D  Q  ;
+ . ; I '$D(C0CTESTMEDS) G USERPC ; DELETE THIS LINE AFTER TESTING IS DONE
+ . D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML)
+ . ; I @MEDOUTXML@(0)=0 D USERPC ; FOR RPMS, USE THE RPC FOR MEDS
+ D EXTRACT^C0CMED1(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
+ I @MEDOUTXML@(0)>0 D  ; C0CMED FOUND ACTIVE OP MEDS
+ . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
+ . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
+ . W MEDCNT,!
+ . W "HAS ACTIVE OP MEDS",!
+ N PENDINGXML,MEDPENDING
+ S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
+ D EXTRACT^C0CMED2(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
+ I @PENDINGXML@(0)>0 D  ; C0CMED FOUND PENDING OP MEDS
+ . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
+ . I @MEDOUTXML@(0)>0 D  ; IF WE NEED TO COMBINE MEDS
+ . . D INSINNER^C0CXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE
+ . E  D CP^C0CXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY
+ . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
+ . ; W MEDCNT,!
+ . W "HAS OP PENDING MEDS",!
+ N PENDINGXML,MEDPENDING
+ S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
+ D EXTRACT^C0CMED3(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
+ I @PENDINGXML@(0)>0 D  ; C0CMED FOUND PENDING OP MEDS
+ . ; S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
+ . I @MEDOUTXML@(0)>0 D  ; IF WE NEED TO COMBINE MEDS
+ . . D INSINNER^C0CXPATH(MEDOUTXML,PENDINGXML) ;ADD NON-VA TO MEDS
+ . E  D CP^C0CXPATH(PENDINGXML,MEDOUTXML) ; NO PREVIOUS MEDS, JUST COPY
+ . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
+ . ; W MEDCNT,!
+ . W "HAS NON-VA MEDS",!
+THEND ;
+ Q ; SKIPPING ALL THE REST OF THIS LOGIC.. IT IS NOT GOING TO BE NEEDED
+ ; ONCE NON-VA AND IP MEDS WORK (C0CMED3 AND C0CMED4)
+USERPC ; ENTRY POINT FOR RPMS
+ N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
+ D ACTIVE^ORWPS(.MEDRSLT,DFN)
+ I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
+ . I DEBUG W "MEDICATIONS RPC RETURNED NULL",!
+ . S @MEDOUTXML@(0)=0
+ . Q
+ ; I DEBUG ZWR MEDRSLT
+ S MEDTVMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
+ S MEDTARYTMP=$NA(^TMP("C0CCCR",$J,"MEDARYTMP"))
+ ; I 'HASOP K @MEDTVMAP,@MEDTARYTMP KILL MOVED TO TOP OF ROUTINE
+ ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
+ ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
+ N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
+ ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
+ S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
+ F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
+ . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
+ . . S ZI=ZI+1 ; INCREMENT MED COUNT
+ . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
+ . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
+ . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
+ . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
+ . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
+ ;ZWR ZA
+ ; S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS
+ F ZI=1:1:ZA(0) D  ; FOR EACH MED
+ . I DEBUG W "ZI IS ",ZI,!
+ . ; W ZI," ",MEDCNT,!
+ . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
+ . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
+ . ;I $P(MEDPTMP,U,1)?1"~OP" Q  ; SKIP OP ACTIVE AND PENDING
+ . S MEDCNT=MEDCNT+1 ; WE ARE GOING TO ADD A MED
+ . S MEDVMAP=$NA(@MEDTVMAP@(MEDCNT)) ; START PAST OP ACTIVE MEDS
+ . S @MEDTVMAP@(0)=@MEDTVMAP@(0)+1 ; ADDING A MED HERE
+ . S @MEDVMAP@("MEDOBJECTID")="MED"_(MEDCNT) ; UNIQUE OBJID FOR MEDS
+ . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
+ . E  S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^C0CUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
+ . S @MEDVMAP@("MEDISSUEDATE")=""
+ . S @MEDVMAP@("MEDLASTFILLDATETXT")=""
+ . S @MEDVMAP@("MEDLASTFILLDATE")=""
+ . S @MEDVMAP@("MEDRXNOTXT")=""
+ . S @MEDVMAP@("MEDRXNO")=""
+ . S @MEDVMAP@("MEDDETAILUNADORNED")=""
+ . S @MEDVMAP@("MEDCONCVALUE")=""
+ . S @MEDVMAP@("MEDCONCUNIT")=""
+ . S @MEDVMAP@("MEDDOSEINDICATOR")=""
+ . S @MEDVMAP@("MEDDELIVERYMETHOD")=""
+ . S @MEDVMAP@("MEDRATEVALUE")=""
+ . S @MEDVMAP@("MEDRATEUNIT")=""
+ . S @MEDVMAP@("MEDVEHICLETEXT")=""
+ . S @MEDVMAP@("MEDFREQUENCYUNIT")=""
+ . S @MEDVMAP@("MEDINTERVALVALUE")=""
+ . S @MEDVMAP@("MEDINTERVALUNIT")=""
+ . S @MEDVMAP@("MEDPRNFLAG")=""
+ . S @MEDVMAP@("MEDPROBLEMOBJECTID")=""
+ . S @MEDVMAP@("MEDPROBLEMTYPETXT")=""
+ . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")=""
+ . S @MEDVMAP@("MEDPROBLEMCODEVALUE")=""
+ . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")=""
+ . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")=""
+ . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")=""
+ . S @MEDVMAP@("MEDSTOPINDICATOR")=""
+ . S @MEDVMAP@("MEDDIRSEQ")=""
+ . S @MEDVMAP@("MEDMULDIRMOD")=""
+ . S @MEDVMAP@("MEDPTINSTRUCTIONS")=""
+ . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
+ . S @MEDVMAP@("MEDDATETIMEAGE")=""
+ . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
+ . S @MEDVMAP@("MEDTYPETEXT")="Medication"
+ . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
+ . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
+ . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
+ . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE
+ . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
+ . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
+ . I $P(MEDPTMP,U,1)?1"~OP" D  ; IS OUTPATIENT, MIGHT HAVE CODE
+ . . I $P(MEDPTMP,"^",10)="ACTIVE" D  ; ONLY ACTIVE MEDS HAVE CODES
+ . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
+ . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
+ . . . I DEBUG W "RXIEN=",RXIEN,! ;
+ . . . ;D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
+ . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D  ; IF SUCCESS
+ . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
+ . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
+ . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
+ . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
+ . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
+ . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
+ . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
+ . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
+ . S @MEDVMAP@("MEDFORMTEXT")=""
+ . S @MEDVMAP@("MEDQUANTITYVALUE")=""
+ . S @MEDVMAP@("MEDQUANTITYUNIT")=""
+ . S @MEDVMAP@("MEDRFNO")=""
+ . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
+ . I ZK>1 D  ; MORE THAN ONE LINE IN MED
+ . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
+ . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
+ . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
+ . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
+ . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
+ . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
+ . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
+ . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
+ . S @MEDVMAP@("MEDDOSEVALUE")=""
+ . S @MEDVMAP@("MEDDOSEUNIT")=""
+ . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
+ . S @MEDVMAP@("MEDDURATIONVALUE")=""
+ . S @MEDVMAP@("MEDDURATIONUNIT")=""
+ . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
+ . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
+ . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
+ . K @MEDARYTMP
+ . D MAP^C0CXPATH(MEDXML,MEDVMAP,MEDARYTMP)
+ . I ZI=1&('HASOP) D  ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE
+ . . ; W "FIRST ONE",!
+ . . D CP^C0CXPATH(MEDARYTMP,MEDOUTXML)
+ . E  D  ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
+ . . D INSINNER^C0CXPATH(MEDOUTXML,MEDARYTMP)
+ N MEDTMP,MEDI
+ D MISSING^C0CXPATH(MEDOUTXML,"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
+ ;
+DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING
+ ; EXAMPLE: $$DIGITS("13R") RETURNS 13
+ N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS
+ S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS
+ Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS
+ ;
Index: ccr/trunk/p/C0CMED1.m
===================================================================
--- ccr/trunk/p/C0CMED1.m	(revision 416)
+++ ccr/trunk/p/C0CMED1.m	(revision 416)
@@ -0,0 +1,229 @@
+C0CMED1 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;01/10/09
+ ;;0.1;CCDCCR;;JUL 16,2008;
+ ;;Last modified Sat Jan 10 21:42:27 PST 2009
+ ; Copyright 2009 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(MINXML,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).
+ ; D PARY^C0CXPATH(MINXML)
+ N MEDS,MAP
+ K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
+ 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
+ N MEDCOUNT S MEDCOUNT=0
+ S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP
+ S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY
+ F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
+ . S MEDCOUNT=MEDCOUNT+1
+ . I DEBUG W "RXIEN IS ",RXIEN,!
+ . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
+ . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED
+ . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
+ . I DEBUG W "MAP= ",MAP,!
+ . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
+ . S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID
+ . ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
+ . S @MAP@("MEDISSUEDATETXT")="Issue Date"
+ . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(1),U))
+ . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
+ . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($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)
+ . ; 12/30/08: I will be using RxNorm for coding...
+ . ; 176.001 is the file for Concepts; 176.003 is the file for
+ . ; sources (i.e. for RxNorm Version)
+ . ;
+ . ; We need the VUID first for the National Drug File entry first
+ . ; We get the VUID of the drug, by looking up the VA Product entry
+ . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
+ . ; Field 99.99 is the VUID.
+ . ;
+ . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
+ . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
+ . ; $$GET1^DIQ.
+ . ;
+ . ; I get the RxNorm name and version from the RxNorm Sources (file
+ . ; 176.003), by searching for "RXNORM", then get the data.
+ . N MEDIEN S MEDIEN=$P(MED(6),U)
+ . D NDF^PSS50(MEDIEN,,,,,"NDF")
+ . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
+ . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+ . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+ . ;
+ . ; NDFIEN is not necessarily defined; it won't be if the drug
+ . ; is not matched to the national drug file (e.g. if the drug is
+ . ; new on the market, compounded, or is a fake drug [blue pill].
+ . ; To protect against failure, I will put an if/else block
+ . ;
+ . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
+ . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
+ . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
+ . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
+ . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
+ . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
+ . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
+ . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
+ . ;
+ . E  S (RXNORM,RXNNAME,RXNVER)=""
+ . ; End if/else block
+ . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
+ . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
+ . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
+ . ;
+ . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
+ . 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 IEN
+ . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
+ . ; These have been collected above.
+ . N CONCDATA
+ . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
+ . ; and this will crash the call. So...
+ . I NDFIEN="" S CONCDATA=""
+ . E  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@("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(MEDIEN,,,,,"QTY")
+ . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
+ . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+ . ;
+ . ; --- START OF DIRECTIONS ---
+ . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
+ . ; we want the compoenents.
+ . ; It's in node 6 of ^PSRX(IEN)
+ . ; So, here we go again
+ . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
+ . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
+ . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
+ . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
+ . ;
+ . N DIRNUM S DIRNUM=0 ; Sigline number
+ . S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS
+ . F  S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM=""  D
+ . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
+ . . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
+ . . ; Invervals... again another call.
+ . . ; In the wisdom of the original programmers, the schedule is a free text field
+ . . ; However, it gets translated by a call to the administration schedule file
+ . . ; to see if that schedule exists.
+ . . ; That's the same thing I am going to do.
+ . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
+ . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
+ . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
+ . . ; So...
+ . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
+ . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
+ . . N INTERVAL
+ . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
+ . . E  D
+ . . . N SUB S SUB=$O(SCHEDATA(0))
+ . . . S INTERVAL=SCHEDATA(SUB,2)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
+ . . N DIRMOD S DIRMOD=$P(SIGDATA,U,6)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"")
+ . ;
+ . ; --- END OF DIRECTIONS ---
+ . ;
+ . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
+ . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
+ . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
+ . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
+ . S @MAP@("MEDRFNO")=MED(9)
+ . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
+ . K @RESULT
+ . D MAP^C0CXPATH(MINXML,MAP,RESULT)
+ . ; D PARY^C0CXPATH(RESULT)
+ . ; MAPPING DIRECTIONS
+ . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
+ . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
+ . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
+ . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
+ . ; N MDZ1,MDZNA
+ . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
+ . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
+ . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
+ . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
+ . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
+ . D:MEDCOUNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
+ . D:MEDCOUNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
+ N MEDTMP,MEDI
+ D MISSING^C0CXPATH(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
+ ;
Index: ccr/trunk/p/C0CMED2.m
===================================================================
--- ccr/trunk/p/C0CMED2.m	(revision 416)
+++ ccr/trunk/p/C0CMED2.m	(revision 416)
@@ -0,0 +1,270 @@
+C0CMED2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista
+ ;;0.1;CCDCCR;;JUL 16,2008;
+ ;;Last Modified Sat Jan 10 21:41:14 PST 2009
+ ; 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(MINXML,DFN,OUTXML)           ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+ ;
+ ; MINXML is the Input XML Template, passed by name
+ ; DFN is Patient IEN
+ ; OUTXML is the resultant XML.
+ ;
+ ; 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, one medicine
+ ;
+ ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending
+ ; meds 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).
+ ; File for pending meds is 52.41
+ ; Unfortuantely, API does not supply us with any useful info beyond
+ ; the IEN in 52.41, and the Med Name, and route.
+ ; So, most of the info is going to get pulled from 52.41.
+ N MEDS,MAP
+ K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
+ D PEN^PSO5241(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
+ N MEDCOUNT S MEDCOUNT=0
+ N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING
+ S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP
+ S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY
+ F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B"  D  ; FOR EACH MEDICATION IN THE LIST
+ . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT  ; Dont' want refill request as a "pending" order
+ . S MEDCOUNT=MEDCOUNT+1
+ . I DEBUG W "RXIEN IS ",RXIEN,!
+ . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
+ . ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN C0CMED
+ . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
+ . I DEBUG W "MAP= ",MAP,!
+ . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
+ . S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
+ . ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
+ . S @MAP@("MEDISSUEDATETXT")="Issue Date"
+ . ; Field 6 is "Effective date", and we pull it in timson format w/ I
+ . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT")
+ . ; Med never filled; next 4 fields are not applicable.
+ . S @MAP@("MEDLASTFILLDATETXT")=""
+ . S @MAP@("MEDLASTFILLDATE")=""
+ . S @MAP@("MEDRXNOTXT")=""
+ . S @MAP@("MEDRXNO")=""
+ . S @MAP@("MEDTYPETEXT")="Medication"
+ . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+ . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
+ . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
+ . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
+ . ; NDC not supplied in API, but is rather trivial to obtain
+ . ; MED(11) piece 1 has the IEN of the drug (file 50)
+ . ; IEN is field 31 in the drug file.
+ . ;
+ . ; MEDIEN (node 11 in the returned output) might not necessarily be defined
+ . ; It is not defined when a dose in not chosen in CPRS. There is a long
+ . ; series of fields that depend on it. We will use If and Else to deal
+ . ; with that
+ . N MEDIEN S MEDIEN=$P(MED(11),U)
+ . I +MEDIEN>0 D  ; start of if/else block
+ . . ; 12/30/08: I will be using RxNorm for coding...
+ . . ; 176.001 is the file for Concepts; 176.003 is the file for
+ . . ; sources (i.e. for RxNorm Version)
+ . . ;
+ . . ; We need the VUID first for the National Drug File entry first
+ . . ; We get the VUID of the drug, by looking up the VA Product entry
+ . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
+ . . ; Field 99.99 is the VUID.
+ . . ;
+ . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
+ . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
+ . . ; $$GET1^DIQ.
+ . . ;
+ . . ; I get the RxNorm name and version from the RxNorm Sources (file
+ . . ; 176.003), by searching for "RXNORM", then get the data.
+ . . D NDF^PSS50(MEDIEN,,,,,"NDF")
+ . . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
+ . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+ . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+ . . ;
+ . . ; NDFIEN is not necessarily defined; it won't be if the drug
+ . . ; is not matched to the national drug file (e.g. if the drug is
+ . . ; new on the market, compounded, or is a fake drug [blue pill].
+ . . ; To protect against failure, I will put an if/else block
+ . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
+ . . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
+ . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
+ . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
+ . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
+ . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
+ . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
+ . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
+ . . ;
+ . . E  S (RXNORM,RXNNAME,RXNVER)=""
+ . . ; End if/else block
+ . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
+ . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
+ . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
+ . . ;
+ . . S @MAP@("MEDBRANDNAMETEXT")=""
+ . . 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; executed above.
+ . . N CONCDATA
+ . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
+ . . ; and this will crash the call. So...
+ . . I NDFIEN="" S CONCDATA=""
+ . . E  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@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
+ . . ; 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(MEDIEN,,,,,"QTY")
+ . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
+ . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+ . E  D
+ . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
+ . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
+ . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
+ . . S @MAP@("MEDBRANDNAMETEXT")=""
+ . . S @MAP@("MEDSTRENGTHVALUE")=""
+ . . S @MAP@("MEDSTRENGTHUNIT")=""
+ . . S @MAP@("MEDFORMTEXT")=""
+ . . S @MAP@("MEDCONCVALUE")=""
+ . . S @MAP@("MEDCONCUNIT")=""
+ . . S @MAP@("MEDSIZETEXT")=""
+ . . S @MAP@("MEDQUANTITYVALUE")=""
+ . . S @MAP@("MEDQUANTITYUNIT")=""
+ . ; end of if/else block
+ . ;
+ . ; --- START OF DIRECTIONS ---
+ . ; Sig data is not in any API. We obtain it using the IEN from
+ . ; the PEN API to file 52.41. It's in field 3, which is a multiple.
+ . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
+ . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
+ . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
+ . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
+ . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
+ . ; DIRNUM will be first piece for IEN.
+ . ; DIRNUM is the proper Sigline numer.
+ . ; SIGDATA is the simplfied array. Subscripts are really field numbers
+ . ; in subfile 52.413.
+ . N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
+ . F  S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM=""  D
+ . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
+ . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
+ . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
+ . . ; If this is an order for a refill; it's not really a new order; move on to next
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
+ . . ; Invervals... again another call.
+ . . ; The schedule is a free text field
+ . . ; However, it gets translated by a call to the administration
+ . . ; schedule file to see if that schedule exists.
+ . . ; That's the same thing I am going to do.
+ . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
+ . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
+ . . ; I looked), PSSFT is the name,
+ . . ; and list is the ^TMP name to store the data in.
+ . . ; Also, freqency may have "PRN" in it, so strip that out
+ . . N FREQ S FREQ=SIGDATA(1)
+ . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
+ . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
+ . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
+ . . N INTERVAL
+ . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
+ . . E  D
+ . . . N SUB S SUB=$O(SCHEDATA(0))
+ . . . S INTERVAL=SCHEDATA(SUB,2)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
+ . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
+ . . N DUR S DUR=SIGDATA(2)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
+ . . N DURUNIT S DURUNIT=$E(DUR)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
+ . ;
+ . ; --- END OF DIRECTIONS ---
+ . ;
+ . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
+ . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
+ . ; W @MAP@("MEDPTINSTRUCTIONS"),!
+ . ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
+ . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
+ . ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
+ . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
+ . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
+ . K @RESULT
+ . D MAP^C0CXPATH(MINXML,MAP,RESULT)
+ . ; D PARY^C0CXPATH(RESULT)
+ . ; MAPPING DIRECTIONS
+ . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
+ . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
+ . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
+ . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
+ . ; N MDZ1,MDZNA
+ . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
+ . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
+ . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
+ . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
+ . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
+ . I MEDFIRST D  ;
+ . . S MEDFIRST=0 ; RESET FIRST FLAG
+ . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
+ . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
+ N MEDTMP,MEDI
+ D MISSING^C0CXPATH(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
+ ;
Index: ccr/trunk/p/C0CMED3.m
===================================================================
--- ccr/trunk/p/C0CMED3.m	(revision 416)
+++ ccr/trunk/p/C0CMED3.m	(revision 416)
@@ -0,0 +1,230 @@
+C0CMED3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista
+ ;;0.1;CCDCCR;;;
+ ;;Last Modified: Sun Jan 11 05:45:03 UTC 2009
+ ; Copyright 2009 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(MINXML,DFN,OUTXML) ; Extract medications into provided xml template
+ ;
+ ; MINXML is the Input XML Template, passed by name
+ ; DFN is Patient IEN
+ ; OUTXML is the resultant XML.
+ ;
+ ; 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, one medicine
+ ;
+ ; Non-VA meds don't have an API. They are stored in file 55, subfile 52.2
+ ; Discontinued meds are indicated by the presence of a value in fields
+ ; 5 or 6 (STATUS 1 or 2, and DISCONTINUED DATE)
+ ; Will use Fileman API GETS^DIQ
+ ;
+ N MEDS,MAP
+ K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
+ K NVA
+ D GETS^DIQ(55,DFN,"52.2*","IE","NVA") ; Output in NVA in FDA array format.
+ ; If NVA does not exist, then patient has no non-VA meds
+ I $D(NVA)=0 S @OUTXML@(0)=0 QUIT
+ ; Otherwise, we go on...
+ M MEDS=NVA(55.05)
+ ; We are done with NVA
+ K NVA
+ ;
+ I DEBUG ZWR MEDS
+ N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
+ S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
+ N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
+ N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE
+ F  S FDAIEN=$O(MEDS(FDAIEN)) Q:FDAIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
+ . N MED M MED=MEDS(FDAIEN)
+ . I MED(5,"I")!MED(6,"I") QUIT  ; If disconinued, we don't want to pull it.
+ . S MEDCOUNT=MEDCOUNT+1
+ . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
+ . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
+ . N RXIEN S RXIEN=$P(FDAIEN,",") ; First piece of FDAIEN is the number of the med for this patient
+ . I DEBUG W "RXIEN IS ",RXIEN,!
+ . I DEBUG W "MAP= ",MAP,!
+ . S @MAP@("MEDOBJECTID")="MED_OUTSIDE"_MEDCOUNT ; MEDCOUNT FOR ID
+ . S @MAP@("MEDISSUEDATETXT")="Documented Date"
+ . ; Field 6 is "Effective date", and we pull it in timson format w/ I
+ . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL(MED(11,"I"),"DT")
+ . ; Med never filled; next 4 fields are not applicable.
+ . S @MAP@("MEDLASTFILLDATETXT")=""
+ . S @MAP@("MEDLASTFILLDATE")=""
+ . S @MAP@("MEDRXNOTXT")=""
+ . S @MAP@("MEDRXNO")=""
+ . S @MAP@("MEDTYPETEXT")="Medication"
+ . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+ . S @MAP@("MEDSTATUSTEXT")="ACTIVE" ; nearest status for pending meds
+ . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_MED(12,"I")
+ . S @MAP@("MEDPRODUCTNAMETEXT")=MED(.01,"E")
+ . ; NDC is field 31 in the drug file.
+ . ; The actual drug entry in the drug file (MEDIEN) is not necessarily supplied.
+ . ; It' node 1, internal form.
+ . N MEDIEN S MEDIEN=MED(1,"I")
+ . I +MEDIEN D  ; start of if/else block
+ . . ; 12/30/08: I will be using RxNorm for coding...
+ . . ; 176.001 is the file for Concepts; 176.003 is the file for
+ . . ; sources (i.e. for RxNorm Version)
+ . . ;
+ . . ; We need the VUID first for the National Drug File entry first
+ . . ; We get the VUID of the drug, by looking up the VA Product entry
+ . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
+ . . ; Field 99.99 is the VUID.
+ . . ;
+ . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
+ . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
+ . . ; $$GET1^DIQ.
+ . . ;
+ . . ; I get the RxNorm name and version from the RxNorm Sources (file
+ . . ; 176.003), by searching for "RXNORM", then get the data.
+ . . D NDF^PSS50(MEDIEN,,,,,"NDF")
+ . . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
+ . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+ . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+ . . ;
+ . . ; NDFIEN is not necessarily defined; it won't be if the drug
+ . . ; is not matched to the national drug file (e.g. if the drug is
+ . . ; new on the market, compounded, or is a fake drug [blue pill].
+ . . ; To protect against failure, I will put an if/else block
+ . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
+ . . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
+ . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
+ . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
+ . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
+ . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
+ . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
+ . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
+ . . ;
+ . . E  S (RXNORM,RXNNAME,RXNVER)=""
+ . . ; End if/else block
+ . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
+ . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
+ . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
+ . . ;
+ . . S @MAP@("MEDBRANDNAMETEXT")=""
+ . . 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; executed above.
+ . . ;
+ . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
+ . . ; and this will crash the call. So...
+ . . I NDFIEN="" S CONCDATA=""
+ . . E  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@("MEDQUANTITYVALUE")=""  ; not provided for in Non-VA meds.
+ . . ; 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(MEDIEN,,,,,"QTY")
+ . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
+ . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+ . E  D
+ . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
+ . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
+ . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
+ . . S @MAP@("MEDBRANDNAMETEXT")=""
+ . . S @MAP@("MEDSTRENGTHVALUE")=""
+ . . S @MAP@("MEDSTRENGTHUNIT")=""
+ . . S @MAP@("MEDFORMTEXT")=""
+ . . S @MAP@("MEDCONCVALUE")=""
+ . . S @MAP@("MEDCONCUNIT")=""
+ . . S @MAP@("MEDSIZETEXT")=""
+ . . S @MAP@("MEDQUANTITYVALUE")=""
+ . . S @MAP@("MEDQUANTITYUNIT")=""
+ . ; End If/Else
+ . ; --- START OF DIRECTIONS ---
+ . ; Dosage is field 2, route is 3, schedule is 4
+ . ; These are all free text fields, and don't point to any files
+ . ; For that reason, I will use the field I never used before:
+ . ; MEDDIRECTIONDESCRIPTIONTEXT
+ . S DIRCNT=1 ; THERE IS ONLY ONE DIRECTION FOR OUTSIDE MEDS
+ . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
+ . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4"  ; means look in description text. See E2369-05.
+ . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
+ . ;
+ . ; --- END OF DIRECTIONS ---
+ . ;
+ . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
+ . I $D(MED(10,1)) D  ;
+ . . S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field
+ . E  S @MAP@("MEDPTINSTRUCTIONS")=""
+ . I $D(MED(14,1)) D  ;
+ . . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
+ . E  S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
+ . S @MAP@("MEDRFNO")=""
+ . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
+ . K @RESULT
+ . D MAP^C0CXPATH(MINXML,MAP,RESULT)
+ . ; D PARY^C0CXPATH(RESULT)
+ . ; MAPPING DIRECTIONS
+ . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
+ . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
+ . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
+ . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
+ . ; N MDZ1,MDZNA
+ . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
+ . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
+ . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
+ . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
+ . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
+ . I MEDFIRST D  ;
+ . . S MEDFIRST=0 ; RESET FIRST FLAG
+ . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
+ . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
+ N MEDTMP,MEDI
+ D MISSING^C0CXPATH(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
+ ;
Index: ccr/trunk/p/C0CMED4.m
===================================================================
--- ccr/trunk/p/C0CMED4.m	(revision 416)
+++ ccr/trunk/p/C0CMED4.m	(revision 416)
@@ -0,0 +1,178 @@
+C0CMED4         ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08
+ ;;0.1;CCDCCR;;;
+ ; 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(MINXML,DFN,OUTXML)           ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+ ;
+ ; MINXML is the Input XML Template, passed by name
+ ; DFN is Patient IEN
+ ; OUTXML is the resultant XML.
+ ;
+ ; MEDS is return array from API.
+ ; MED is holds each array element from MEDS, one medicine
+ ; MAP is a mapping variable map (store result) for each med
+ ;
+ ; Inpatient Meds will be extracted using this routine and and the one following.
+ ; Inpatient Meds Unit Dose is going to be C0CMED4
+ ; Inpatient Meds IVs is going to be C0CMED5
+ ;
+ ; We will use two Pharmacy ReEnginnering API's:
+ ; PSS431^PSS55(DFN,PO,PSDATE,PEDATE,LIST) - provides most info
+ ; PSS432^PSS55(DFN,PO,LIST) - provides schedule info
+ ; For more information, see the PRE documentation at:
+ ; http://www.va.gov/vdl/documents/Clinical/Pharm-Inpatient_Med/phar_1_api_r0807.pdf
+ ; 
+ ; Med data is stored in Unit Dose multiple of file 55, pharmacy patient
+ ;
+ N MEDS,MAP
+ K ^TMP($J)
+ D PSS431^PSS55(DFN,,,,"UD") ; Output is in ^TMP($J,"UD",*)
+ I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT  ; No Meds - Quit
+ ; Otherwise, we go on...
+ M MEDS=^TMP($J,"UD")
+ I DEBUG ZWR MEDS
+ S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) 
+ N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
+ N I S I=0 
+ F  S I=$O(MEDS("B",I)) Q:'I  D  ; For each medication in B index
+ . N MED M MED=MEDS(I)
+ . S MEDCOUNT=MEDCOUNT+1
+ . S @MEDMAP@(0)=MEDCOUNT ; Update MedMap array counter
+ . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
+ . N RXIEN S RXIEN=MED(.01) ; Order Number
+ . I DEBUG W "RXIEN IS ",RXIEN,!
+ . I DEBUG W "MAP= ",MAP,!
+ . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN 
+ . S @MAP@("MEDISSUEDATETXT")="Order Date"
+ . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
+ . S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient
+ . S @MAP@("MEDLASTFILLDATE")="" ; For Outpatient
+ . S @MAP@("MEDRXNOTXT")="" ; For Outpatient
+ . S @MAP@("MEDRXNO")="" ; For Outpatient
+ . S @MAP@("MEDTYPETEXT")="Medication"
+ . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+ . S @MAP@("MEDSTATUSTEXT")="ACTIVE" 
+ . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)
+ . S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01)
+ . ; NDC is field 31 in the drug file.
+ . ; The actual drug entry in the drug file is not necessarily supplied.
+ . ; It' node 1, internal form.
+ . N MEDIEN S MEDIEN=MED(1,"I")
+ . S @MAP@("MEDPRODUCTNAMECODEVALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"")
+ . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"")
+ . S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"")
+ . S @MAP@("MEDBRANDNAMETEXT")=""
+ . I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE")
+ . I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
+ . S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"")
+ . S @MAP@("MEDSTRENGTHUNIT")=$S($P(DOSEDATA(902),U,2),1:"")
+ . ; 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 NDFDATA,CONCDATA
+ . I $L(MEDIEN) D
+ . . D NDF^PSS50(MEDIEN,,,,,"CONC")
+ . . M NDFDATA=^TMP($J,"CONC",MEDIEN)
+ . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+ . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+ . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
+ . . ; and this will crash the call. So...
+ . . I NDFIEN="" S CONCDATA=""
+ . . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
+ . E  S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors.
+ . S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"")
+ . S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"")
+ . S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"")
+ . S @MAP@("MEDQUANTITYVALUE")=""  ; not provided for in Non-VA meds.
+ . ; 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
+ . I $L(MEDIEN) D
+ . . D DATA^PSS50(MEDIEN,,,,,"QTY")
+ . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
+ . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+   E  S @MAP@("MEDQUANTITYUNIT")=""
+ . ;
+ . ; --- START OF DIRECTIONS ---
+ . ; Dosage is field 2, route is 3, schedule is 4
+ . ; These are all free text fields, and don't point to any files
+ . ; For that reason, I will use the field I never used before:
+ . ; MEDDIRECTIONDESCRIPTIONTEXT
+ . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
+ . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4"  ; means look in description text. See E2369-05.
+ . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""  
+ . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""  
+ . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""  
+ . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 
+ . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
+ . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
+ . ;
+ . ; --- END OF DIRECTIONS ---
+ . ;
+ . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
+ . S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field
+ . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
+ . S @MAP@("MEDRFNO")=""
+ . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
+ . K @RESULT
+ . D MAP^GPLXPATH(MINXML,MAP,RESULT)
+ . ; D PARY^GPLXPATH(RESULT)
+ . ; MAPPING DIRECTIONS
+ . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
+ . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
+ . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
+ . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
+ . ; N MDZ1,MDZNA
+ . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
+ . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
+ . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
+ . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
+ . . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
+ . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
+ . D:MEDCOUNT>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
+ ;
Index: ccr/trunk/p/C0CMED6.m
===================================================================
--- ccr/trunk/p/C0CMED6.m	(revision 416)
+++ ccr/trunk/p/C0CMED6.m	(revision 416)
@@ -0,0 +1,324 @@
+C0CMED6 ; WV/CCDCCR/SMH - Meds from RPMS: Outpatient Meds;01/10/09
+ ;;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(MINXML,DFN,OUTXML)  ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+ ;
+ ; MINXML and OUTXML are passed by name so globals can be used
+ ; MINXML will contain only the medications skeleton 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.
+ ;
+ ; GETRXS^BEHORXFN(ARRAYNAME,DFN,DAYS) will be the the API used.
+ ; This API has been developed by Medsphere for IHS for getting
+ ; Medications from RPMS. It has most of what we need.
+ ; API written by Doug Martin when he worked for Medsphere (thanks Doug!)
+ ; -- ARRAYNAME is passed by name (required)
+ ; -- DFN is passed by value (required)
+ ; -- DAYS is passed by value (optional; if not passed defaults to 365)
+ ; 
+ ; Return:
+ ; ~Type^PharmID^Drug^InfRate^StopDt^RefRem^TotDose^UnitDose^OrderID 
+ ; ^Status^LastFill^Chronic^Issued^Rx #^Provider^ 
+ ; Status Reason^DEA Handling
+ ; 
+ N MEDS,MEDS1,MAP
+ D GETRXS^BEHORXFN("MEDS1",DFN,365) ; Days hard set to 365
+ ; If MEDS1 is not defined, then no meds
+ I '$D(MEDS1) S @OUTXML@(0)=0 QUIT
+ I DEBUG ZWR MEDS1,MINXML
+ N MEDCNT S MEDCNT=0 ; Med Count
+ ; The next line is a super line. It goes through the array return
+ ; and if the first characters are ~OP, it grabs the line.
+ ; This means that line is for a dispensed Outpatient Med.
+ ; That line has the metadata about the med that I need.
+ ; The next lines, however many, are the med and the sig.
+ ; I won't be using those because I have to get the sig parsed exactly.
+ N J S J="" F  S J=$O(MEDS1(J)) Q:J=""  I $E(MEDS1(J),1,3)="~OP" S MEDCNT=MEDCNT+1 S MEDS(MEDCNT)=MEDS1(J)
+ K MEDS1
+ S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) ; this is the variable map
+ S @MEDMAP@(0)=0 ; Initial count of meds
+ S MEDCNT="" ; Initialize for $Order
+ F  S MEDCNT=$O(MEDS(MEDCNT)) Q:MEDCNT=""  D  ; for each medication in the list
+ . I DEBUG W "MEDCNT IS ",MEDCNT,!
+ . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCNT))
+ . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED
+ . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; increment total meds in var array
+ . I DEBUG W "MAP= ",MAP,!
+ . S @MAP@("MEDOBJECTID")="MED"_MEDCNT ; MEDCNT FOR ID
+ . S @MAP@("MEDISSUEDATETXT")="Issue Date"
+ . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,13))
+ . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
+ . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,11))
+ . S @MAP@("MEDRXNOTXT")="Prescription Number"
+ . S @MAP@("MEDRXNO")=$P(MEDS(MEDCNT),U,14)
+ . S @MAP@("MEDTYPETEXT")="Medication"
+ . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+ . S @MAP@("MEDSTATUSTEXT")=$P(MEDS(MEDCNT),U,10)
+ . ; Provider only provided in API as text, not DUZ.
+ . ; We need to get DUZ from filman file 52 (Prescription)
+ . ; Field 4; IEN is Piece 2 of Meds stripped of trailing characters.
+ . ; Note that I will use RXIEN several times later
+ . N RXIEN S RXIEN=+$P(MEDS(MEDCNT),U,2)
+ . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52,RXIEN,4,"I")
+ . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MEDS(MEDCNT),U,3)
+ . ; --- RxNorm Stuff 
+ . ; 176.001 is the file for Concepts; 176.003 is the file for
+ . ; sources (i.e. for RxNorm Version)
+ . ; 
+ . ; I use 176.001 for the Vista version of this routine (files 1-3)
+ . ; Since IHS does not have VUID's, I will be getting RxNorm codes
+ . ; using NDCs. My specially crafted index (sounds evil) named "NDC"
+ . ; is in file 176.002. The file is called RxNorm NDC to VUID.
+ . ; Except that I don't need the VUID, but it's there if I need it.
+ . ; 
+ . ; We obviously need the NDC. That is easily obtained from the prescription.
+ . ; Field 27 in file 52
+ . N NDC S NDC=$$GET1^DIQ(52,RXIEN,27,"I")
+ . ; I discovered that file 176.002 might give you two codes for the NDC
+ . ; One for the Clinical Drug, and one for the ingredient.
+ . ; So the plan is to get the two RxNorm codes, and then find from
+ . ; file 176.001 which one is the Clinical Drug.
+ . ; ... I refactored this into GETRXN
+ . N RXNORM,SRCIEN,RXNNAME,RXNVER
+ . I +NDC,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
+ . . S RXNORM=$$GETRXN(NDC)
+ . . S SRCIEN=$$FIND1^DIC(176.003,,,"RXNORM","B")
+ . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
+ . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
+ . ;
+ . E  S (RXNORM,RXNNAME,RXNVER)=""
+ . ; End if/else block
+ . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
+ . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
+ . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
+ . ; --- End RxNorm section
+ . ;
+ . ; Brand name is 52 field 6.5
+ . S @MAP@("MEDBRANDNAMETEXT")=$$GET1^DIQ(52,RXIEN,6.5)
+ . ;
+ . ; Next I need Med Form (tab, cap etc), strength (250mg)
+ . ; concentration for liquids (250mg/mL)
+ . ; Since IHS does not have any of the new calls that 
+ . ; Vista has, I will be doing a crosswalk:
+ . ; File 52, field 6 is Drug IEN in file 50
+ . ; File 50, field 22 is VA Product IEN in file 50.68
+ . ; In file 50.68, I will get the following:
+ . ; -- 1: Dosage Form
+ . ; -- 2: Strength
+ . ; -- 3: Units
+ . ; -- 8: Dispense Units
+ . ; -- Conc is 2 concatenated with 3
+ . ; 
+ . ; *** If Drug is not matched to NDF, then VA Product will be "" ***
+ . ;
+ . N MEDIEN S MEDIEN=$$GET1^DIQ(52,RXIEN,6,"I") ; Drug IEN in 50
+ . N VAPROD S VAPROD=$$GET1^DIQ(50,MEDIEN,22,"I") ; VA Product in file 50.68
+ . I +VAPROD D
+ . . S @MAP@("MEDSTRENGTHVALUE")=$$GET1^DIQ(50.68,VAPROD,2)
+ . . S @MAP@("MEDSTRENGTHUNIT")=$$GET1^DIQ(50.68,VAPROD,3)
+ . . S @MAP@("MEDFORMTEXT")=$$GET1^DIQ(50.68,VAPROD,1)
+ . . S @MAP@("MEDCONCVALUE")=@MAP@("MEDSTRENGTHVALUE")
+ . . S @MAP@("MEDCONCUNIT")=@MAP@("MEDSTRENGTHUNIT")
+ . E  D
+ . . S @MAP@("MEDSTRENGTHVALUE")=""
+ . . S @MAP@("MEDSTRENGTHUNIT")=""
+ . . S @MAP@("MEDFORMTEXT")=""
+ . . S @MAP@("MEDCONCVALUE")=""
+ . . S @MAP@("MEDCONCUNIT")=""
+ . ; End Strengh/Conc stuff
+ . ;
+ . ; Quantity is in the prescription, field 7
+ . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52,RXIEN,7)
+ . ; Dispense unit is in the drug file, field 14.5
+ . S @MAP@("MEDQUANTITYUNIT")=$$GET1^DIQ(50,MEDIEN,14.5)
+ . ;
+ . ; --- START OF DIRECTIONS ---
+ . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
+ . ; we want the components.
+ . ; It's in multiple 113 in the Prescription File (52)
+ . ; #.01 DOSAGE ORDERED [1F] 			"20"
+ . ; #1 DISPENSE UNITS PER DOSE [2N] 	"1"
+ . ; #2 UNITS [3P:50.607] 				"MG"
+ . ; #3 NOUN [4F]						"TABLET"
+ . ; #4 DURATION [5F] 					"10D"
+ . ; #5 CONJUNCTION [6S] 				"AND"
+ . ; #6 ROUTE [7P:51.2] 				"ORAL"
+ . ; #7 SCHEDULE [8F] 					"BID"
+ . ; #8 VERB [9F] 						"TAKE"
+ . ;
+ . ; Will use GETS^DIQ to get fields.
+ . ; Data comes out like this:
+ . ; SAMINS(52.0113,"1,23,",.01)=20
+ . ; SAMINS(52.0113,"1,23,",1)=1
+ . ; SAMINS(52.0113,"1,23,",2)="MG"
+ . ; SAMINS(52.0113,"1,23,",3)="TABLET"
+ . ; SAMINS(52.0113,"1,23,",4)="5D"
+ . ; SAMINS(52.0113,"1,23,",5)="THEN"
+ . ;
+ . N RAWDATA
+ . D GETS^DIQ(52,RXIEN,"113*",,"RAWDATA","DIERR")
+ . D:$D(DIERR) ^%ZTER  ; Log if there's an error in retrieving sig field
+ . ; none the less, continue; some parts are retrievable.
+ . N FMSIG M FMSIG=RAWDATA(52.0113) ; Merge into subfile...
+ . K RAWDATA
+ . N FMSIGNUM S FMSIGNUM="" ; Sigline number in fileman.
+ . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
+ . ; DIRCNT is the proper Sigline numer.
+ . ; SIGDATA is the simplfied array. 
+ . F  S FMSIGNUM=$O(FMSIG(FMSIGNUM)) Q:FMSIGNUM=""  D
+ . . N DIRCNT S DIRCNT=$P(FMSIGNUM,",")
+ . . N SIGDATA M SIGDATA=FMSIG(FMSIGNUM)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$G(SIGDATA(8))
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$G(SIGDATA(.01))
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=$G(SIGDATA(2))
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$G(SIGDATA(6))
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$G(SIGDATA(7))
+ . . ; Invervals... again another call.
+ . . ; In the wisdom of the original programmers, the schedule is a free text field
+ . . ; However, it gets translated by a call to the administration schedule file
+ . . ; to see if that schedule exists.
+ . . ; That's the same thing I am going to do.
+ . . ; Search B index of 51.1 (Admin Schedule) with schedule
+ . . ; First, remove "PRN" if it exists (don't ask, that's how the file
+ . . ; works; I wouldn't do it that way).
+ . . N SCHNOPRN S SCHNOPRN=$G(SIGDATA(7))
+ . . I SCHNOPRN["PRN" S SCHNOPRN=$E(SCHNOPRN,1,$F(SCHNOPRN,"PRN")-5)
+ . . ; Super call below:
+ . . ; 1=File 51.1 3=Field 2 (Frequency in Minutes)
+ . . ; 4=Packed format, Exact Match 5=Lookup Value
+ . . ; 6=# of entries to return 7=Index 10=Return Array
+ . . ; 
+ . . ; I do not account for the fact that two schedules can be
+ . . ; spelled identically (ie duplicate entry). In that case,
+ . . ; I get the first. That's just a bad pharmacy pkg maintainer.
+ . . N C0C515
+ . . D FIND^DIC(51.1,,"@;2","PX",SCHNOPRN,1,"B",,,"C0C515")
+ . . N INTERVAL S INTERVAL="" ; Default
+ . . ; If there are entries found, get it
+ . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2) 
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
+ . . ; Duration is 10M minutes, 10H hours, 10D for Days
+ . . ; 10W for weeks, 10L for months. I smell $Select
+ . . ; But we don't need to do that if there isn't a duration
+ . . I +$G(SIGDATA(4)) D
+ . . . N DURUNIT S DURUNIT=$E(SIGDATA(4),$L(SIGDATA(4))) ; get last char
+ . . . N DURTXT S DURTXT=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"Days")
+ . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=+SIGDATA(4)
+ . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=DURTXT
+ . . E  D
+ . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=""
+ . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$G(SIGDATA(4))["PRN"
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" ; when avail
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; not stored
+ . . ; Another confusing line; I am pretty bad:
+ . . ; If there is another entry in the FMSIG array (i.e. another line
+ . . ; in the sig), set the direction count indicator.
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=""  ; Default
+ . . S:+$O(FMSIG(FMSIGNUM)) @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRCNT
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$G(SIGDATA(5))
+ . ;
+ . ; --- END OF DIRECTIONS ---
+ . ;
+ . ; Med instructions is a WP field, thus the acrobatics
+ . ; Notice buffer overflow protection set at 10,000 chars
+ . ; -- 1. Med Patient Instructions
+ . N MEDPTIN1 S MEDPTIN1=$$GET1^DIQ(52,RXIEN,115,,"MEDPTIN1")
+ . N MEDPTIN2,J  S (MEDPTIN2,J)="" 
+ . I $L(MEDPTIN1) F  S J=$O(@MEDPTIN1@(J)) Q:J=""  Q:$L(MEDPTIN2)>10000  S MEDPTIN2=MEDPTIN2_@MEDPTIN1@(J)_" "
+ . S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2
+ . K J
+ . ; -- 2. Med Provider Instructions
+ . N MEDPVIN1 S MEDPVIN1=$$GET1^DIQ(52,RXIEN,39,,"MEDPVIN1")
+ . N MEDPVIN2,J S (MEDPVIN2,J)=""
+ . I $L(MEDPVIN1) F  S J=$O(@MEDPVIN1@(J)) Q:J=""  Q:$L(MEDPVIN2)>10000  S MEDPVIN2=MEDPVIN2_@MEDPVIN1@(J)_" "
+ . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MEDPVIN2
+ . ;
+ . ; Remaining refills
+ . S @MAP@("MEDRFNO")=$P(MEDS(MEDCNT),U,6)
+ . ; ------ END OF MAPPING
+ . ;
+ . ; ------ BEGIN XML INSERTION
+ . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
+ . K @RESULT
+ . D MAP^C0CXPATH(MINXML,MAP,RESULT)
+ . ; D PARY^C0CXPATH(RESULT)
+ . ; MAPPING DIRECTIONS
+ . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
+ . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
+ . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
+ . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
+ . ; N MDZ1,MDZNA
+ . N DIRCNT S DIRCNT=""
+ . I +$O(@MAP@("M","DIRECTIONS",DIRCNT)) D  ; IF THERE ARE DIRCTIONS
+ . . F DIRCNT=$O(@MAP@("M","DIRECTIONS",DIRCNT)) D  ; FOR EACH DIRECTION
+ . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",DIRCNT))
+ . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
+ . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
+ . D:MEDCNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
+ . D:MEDCNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
+ N MEDTMP,MEDI
+ D MISSING^C0CXPATH(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
+ ;
+GETRXN(NDC) ; Extrinsic Function; PUBLIC; NDC to RxNorm
+ ;; Get RxNorm Concept Number for a Given NDC
+ ;
+ S NDC=$TR(NDC,"-")  ; Remove dashes
+ N RXNORM,C0CZRXN,DIERR
+ D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR")
+ I $D(DIERR) D ^%ZTER BREAK
+ S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries
+ N I S I=0
+ F  S I=$O(C0CZRXN("DILIST",I)) Q:I=""  S RXNORM(I)=$P(C0CZRXN("DILIST",I,0),U,2)
+ ; At this point, RxNorm(0) is # of entries; RxNorm(1...) are the entries
+ ; If RxNorm(0) is 1, then we only have one entry, and that's it.
+ I RXNORM(0)=1 QUIT RXNORM(1)  ; RETURN RXNORM(1)
+ ; Otherwise, we need to find out which one is the semantic
+ ; clinical drug. I built an index on 176.001 (RxNorm Concepts)
+ ; for that purpose.
+ I RXNORM(0)>1 D
+ . S I=0
+ . F  S I=$O(RXNORM(I)) Q:I=""  D  Q:$G(RXNORM)
+ . . N RXNIEN S RXNIEN=$$FIND1^DIC(176.001,,,RXNORM(I),"SCD")
+ . . I +$G(RXNIEN)=0 QUIT  ; try the next entry... 
+ . . E  S RXNORM=RXNORM(I) QUIT  ; We found the right code
+ QUIT +$G(RXNORM)  ; RETURN RXNORM; if we couldn't find a clnical drug, return with 0
+ 
Index: ccr/trunk/p/C0CUNIT.m
===================================================================
--- ccr/trunk/p/C0CUNIT.m	(revision 415)
+++ ccr/trunk/p/C0CUNIT.m	(revision 416)
@@ -166,8 +166,8 @@
  W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
  D QUERY^GPLXPATH(T,XPATH,"INXML")
- W "Executing EXTRACT^CCRMEDS(INXML,DFN,OUTXML)",!
+ W "Executing EXTRACT^C0CMED(INXML,DFN,OUTXML)",!
  W "OUTXML will be ^TMP($J,""OUT"")",!
  N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
- D EXTRACT^CCRMEDS6("INXML",DFN,OUTXML)
+ D EXTRACT^C0CMED6("INXML",DFN,OUTXML)
  D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml")
  Q
Index: ccr/trunk/p/CCRMEDS.m
===================================================================
--- ccr/trunk/p/CCRMEDS.m	(revision 415)
+++ 	(revision )
@@ -1,209 +1,0 @@
-CCRMEDS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08  14:33
- ;;0.1;CCDCCR;;JUL 16,2008;
- ;Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel.
- ;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(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
- ;
- ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
- ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
- ;
- N HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS
- N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED
- ; OUTPATIENT ACTIVE MEDS ARE PROCESSED IN EXTRACT^CCRMEDS1
- ; OUTPATIENT PENDING MEDS IN EXTRACT^CCRMEDS2
- ; NON-VA MEDS IN EXTRACT^CCRMEDS3
- ; INPATIENT MEDS IN EXTRACT^CCRMEDS4
- ; ALL OTHERS HERE
- S MEDTVMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
- K @MEDTVMAP ; CLEAR VARIABLE ARRAY
- S @MEDTVMAP@(0)=0 ; INITIALIZE NUMBER OF MEDS PROCESSED
- S MEDTARYTMP=$NA(^TMP("C0CCCR",$J,"MEDARYTMP"))
- K @MEDTARYTMP ; KILL XML ARRAY
- I $G(DUZ("AG"))="I" D  Q  ;
- . ; I '$D(C0CTESTMEDS) G USERPC ; DELETE THIS LINE AFTER TESTING IS DONE
- . D EXTRACT^CCRMEDS6(MEDXML,DFN,MEDOUTXML)
- . ; I @MEDOUTXML@(0)=0 D USERPC ; FOR RPMS, USE THE RPC FOR MEDS
- D EXTRACT^CCRMEDS1(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
- I @MEDOUTXML@(0)>0 D  ; CCRMEDS FOUND ACTIVE OP MEDS
- . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
- . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
- . W MEDCNT,!
- . W "HAS ACTIVE OP MEDS",!
- N PENDINGXML,MEDPENDING
- S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
- D EXTRACT^CCRMEDS2(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
- I @PENDINGXML@(0)>0 D  ; CCRMEDS FOUND PENDING OP MEDS
- . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
- . I @MEDOUTXML@(0)>0 D  ; IF WE NEED TO COMBINE MEDS
- . . D INSINNER^C0CXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE
- . E  D CP^C0CXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY
- . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
- . ; W MEDCNT,!
- . W "HAS OP PENDING MEDS",!
- N PENDINGXML,MEDPENDING
- S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
- D EXTRACT^CCRMEDS3(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
- I @PENDINGXML@(0)>0 D  ; CCRMEDS FOUND PENDING OP MEDS
- . ; S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
- . I @MEDOUTXML@(0)>0 D  ; IF WE NEED TO COMBINE MEDS
- . . D INSINNER^C0CXPATH(MEDOUTXML,PENDINGXML) ;ADD NON-VA TO MEDS
- . E  D CP^C0CXPATH(PENDINGXML,MEDOUTXML) ; NO PREVIOUS MEDS, JUST COPY
- . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
- . ; W MEDCNT,!
- . W "HAS NON-VA MEDS",!
-THEND ;
- Q ; SKIPPING ALL THE REST OF THIS LOGIC.. IT IS NOT GOING TO BE NEEDED
- ; ONCE NON-VA AND IP MEDS WORK (CCRMEDS3 AND CCRMEDS4)
-USERPC ; ENTRY POINT FOR RPMS
- N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
- D ACTIVE^ORWPS(.MEDRSLT,DFN)
- I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
- . I DEBUG W "MEDICATIONS RPC RETURNED NULL",!
- . S @MEDOUTXML@(0)=0
- . Q
- ; I DEBUG ZWR MEDRSLT
- M C0CMEDS=MEDRSLT
- S MEDTVMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
- S MEDTARYTMP=$NA(^TMP("C0CCCR",$J,"MEDARYTMP"))
- ; I 'HASOP K @MEDTVMAP,@MEDTARYTMP KILL MOVED TO TOP OF ROUTINE
- ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
- ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
- N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
- ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
- S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
- F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
- . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
- . . S ZI=ZI+1 ; INCREMENT MED COUNT
- . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
- . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
- . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
- . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
- . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
- ;ZWR ZA
- ; S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS
- F ZI=1:1:ZA(0) D  ; FOR EACH MED
- . I DEBUG W "ZI IS ",ZI,!
- . ; W ZI," ",MEDCNT,!
- . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
- . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
- . ;I $P(MEDPTMP,U,1)?1"~OP" Q  ; SKIP OP ACTIVE AND PENDING
- . S MEDCNT=MEDCNT+1 ; WE ARE GOING TO ADD A MED
- . S MEDVMAP=$NA(@MEDTVMAP@(MEDCNT)) ; START PAST OP ACTIVE MEDS
- . S @MEDTVMAP@(0)=@MEDTVMAP@(0)+1 ; ADDING A MED HERE
- . S @MEDVMAP@("MEDOBJECTID")="MED"_(MEDCNT) ; UNIQUE OBJID FOR MEDS
- . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
- . E  S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^C0CUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
- . S @MEDVMAP@("MEDISSUEDATE")=""
- . S @MEDVMAP@("MEDLASTFILLDATETXT")=""
- . S @MEDVMAP@("MEDLASTFILLDATE")=""
- . S @MEDVMAP@("MEDRXNOTXT")=""
- . S @MEDVMAP@("MEDRXNO")=""
- . S @MEDVMAP@("MEDDETAILUNADORNED")=""
- . S @MEDVMAP@("MEDCONCVALUE")=""
- . S @MEDVMAP@("MEDCONCUNIT")=""
- . S @MEDVMAP@("MEDDOSEINDICATOR")=""
- . S @MEDVMAP@("MEDDELIVERYMETHOD")=""
- . S @MEDVMAP@("MEDRATEVALUE")=""
- . S @MEDVMAP@("MEDRATEUNIT")=""
- . S @MEDVMAP@("MEDVEHICLETEXT")=""
- . S @MEDVMAP@("MEDFREQUENCYUNIT")=""
- . S @MEDVMAP@("MEDINTERVALVALUE")=""
- . S @MEDVMAP@("MEDINTERVALUNIT")=""
- . S @MEDVMAP@("MEDPRNFLAG")=""
- . S @MEDVMAP@("MEDPROBLEMOBJECTID")=""
- . S @MEDVMAP@("MEDPROBLEMTYPETXT")=""
- . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")=""
- . S @MEDVMAP@("MEDPROBLEMCODEVALUE")=""
- . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")=""
- . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")=""
- . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")=""
- . S @MEDVMAP@("MEDSTOPINDICATOR")=""
- . S @MEDVMAP@("MEDDIRSEQ")=""
- . S @MEDVMAP@("MEDMULDIRMOD")=""
- . S @MEDVMAP@("MEDPTINSTRUCTIONS")=""
- . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
- . S @MEDVMAP@("MEDDATETIMEAGE")=""
- . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
- . S @MEDVMAP@("MEDTYPETEXT")="Medication"
- . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
- . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
- . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
- . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE
- . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
- . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
- . I $P(MEDPTMP,U,1)?1"~OP" D  ; IS OUTPATIENT, MIGHT HAVE CODE
- . . I $P(MEDPTMP,"^",10)="ACTIVE" D  ; ONLY ACTIVE MEDS HAVE CODES
- . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
- . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
- . . . I DEBUG W "RXIEN=",RXIEN,! ;
- . . . ;D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
- . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D  ; IF SUCCESS
- . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
- . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
- . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
- . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
- . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
- . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
- . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
- . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
- . S @MEDVMAP@("MEDFORMTEXT")=""
- . S @MEDVMAP@("MEDQUANTITYVALUE")=""
- . S @MEDVMAP@("MEDQUANTITYUNIT")=""
- . S @MEDVMAP@("MEDRFNO")=""
- . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
- . I ZK>1 D  ; MORE THAN ONE LINE IN MED
- . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
- . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
- . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
- . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
- . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
- . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
- . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
- . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
- . S @MEDVMAP@("MEDDOSEVALUE")=""
- . S @MEDVMAP@("MEDDOSEUNIT")=""
- . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
- . S @MEDVMAP@("MEDDURATIONVALUE")=""
- . S @MEDVMAP@("MEDDURATIONUNIT")=""
- . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
- . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
- . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
- . K @MEDARYTMP
- . D MAP^C0CXPATH(MEDXML,MEDVMAP,MEDARYTMP)
- . I ZI=1&('HASOP) D  ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE
- . . ; W "FIRST ONE",!
- . . D CP^C0CXPATH(MEDARYTMP,MEDOUTXML)
- . E  D  ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
- . . D INSINNER^C0CXPATH(MEDOUTXML,MEDARYTMP)
- N MEDTMP,MEDI
- D MISSING^C0CXPATH(MEDOUTXML,"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
- ;
-DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING
- ; EXAMPLE: $$DIGITS("13R") RETURNS 13
- N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS
- S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS
- Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS
- ;
Index: ccr/trunk/p/CCRMEDS1.m
===================================================================
--- ccr/trunk/p/CCRMEDS1.m	(revision 415)
+++ 	(revision )
@@ -1,229 +1,0 @@
-CCRMEDS1 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;01/10/09
- ;;0.1;CCDCCR;;JUL 16,2008;
- ;;Last modified Sat Jan 10 21:42:27 PST 2009
- ; Copyright 2009 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(MINXML,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).
- ; D PARY^C0CXPATH(MINXML)
- N MEDS,MAP
- K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
- 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
- N MEDCOUNT S MEDCOUNT=0
- S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP
- S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY
- F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
- . S MEDCOUNT=MEDCOUNT+1
- . I DEBUG W "RXIEN IS ",RXIEN,!
- . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
- . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN CCRMEDS
- . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
- . I DEBUG W "MAP= ",MAP,!
- . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
- . S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID
- . ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
- . S @MAP@("MEDISSUEDATETXT")="Issue Date"
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(1),U))
- . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
- . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($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)
- . ; 12/30/08: I will be using RxNorm for coding...
- . ; 176.001 is the file for Concepts; 176.003 is the file for
- . ; sources (i.e. for RxNorm Version)
- . ;
- . ; We need the VUID first for the National Drug File entry first
- . ; We get the VUID of the drug, by looking up the VA Product entry
- . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
- . ; Field 99.99 is the VUID.
- . ;
- . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
- . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
- . ; $$GET1^DIQ.
- . ;
- . ; I get the RxNorm name and version from the RxNorm Sources (file
- . ; 176.003), by searching for "RXNORM", then get the data.
- . N MEDIEN S MEDIEN=$P(MED(6),U)
- . D NDF^PSS50(MEDIEN,,,,,"NDF")
- . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
- . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
- . N VAPROD S VAPROD=$P(NDFDATA(22),U)
- . ;
- . ; NDFIEN is not necessarily defined; it won't be if the drug
- . ; is not matched to the national drug file (e.g. if the drug is
- . ; new on the market, compounded, or is a fake drug [blue pill].
- . ; To protect against failure, I will put an if/else block
- . ;
- . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
- . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
- . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
- . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
- . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
- . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
- . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
- . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
- . ;
- . E  S (RXNORM,RXNNAME,RXNVER)=""
- . ; End if/else block
- . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
- . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
- . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
- . ;
- . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
- . 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 IEN
- . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
- . ; These have been collected above.
- . N CONCDATA
- . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
- . ; and this will crash the call. So...
- . I NDFIEN="" S CONCDATA=""
- . E  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@("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(MEDIEN,,,,,"QTY")
- . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
- . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
- . ;
- . ; --- START OF DIRECTIONS ---
- . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
- . ; we want the compoenents.
- . ; It's in node 6 of ^PSRX(IEN)
- . ; So, here we go again
- . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
- . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
- . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
- . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
- . ;
- . N DIRNUM S DIRNUM=0 ; Sigline number
- . S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS
- . F  S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM=""  D
- . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
- . . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
- . . ; Invervals... again another call.
- . . ; In the wisdom of the original programmers, the schedule is a free text field
- . . ; However, it gets translated by a call to the administration schedule file
- . . ; to see if that schedule exists.
- . . ; That's the same thing I am going to do.
- . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
- . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
- . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
- . . ; So...
- . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
- . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
- . . N INTERVAL
- . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
- . . E  D
- . . . N SUB S SUB=$O(SCHEDATA(0))
- . . . S INTERVAL=SCHEDATA(SUB,2)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
- . . N DIRMOD S DIRMOD=$P(SIGDATA,U,6)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"")
- . ;
- . ; --- END OF DIRECTIONS ---
- . ;
- . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
- . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
- . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
- . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
- . S @MAP@("MEDRFNO")=MED(9)
- . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
- . K @RESULT
- . D MAP^C0CXPATH(MINXML,MAP,RESULT)
- . ; D PARY^C0CXPATH(RESULT)
- . ; MAPPING DIRECTIONS
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
- . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
- . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
- . ; N MDZ1,MDZNA
- . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
- . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
- . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
- . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
- . D:MEDCOUNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
- . D:MEDCOUNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
- N MEDTMP,MEDI
- D MISSING^C0CXPATH(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
- ;
Index: ccr/trunk/p/CCRMEDS2.m
===================================================================
--- ccr/trunk/p/CCRMEDS2.m	(revision 415)
+++ 	(revision )
@@ -1,270 +1,0 @@
-CCRMEDS2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista
- ;;0.1;CCDCCR;;JUL 16,2008;
- ;;Last Modified Sat Jan 10 21:41:14 PST 2009
- ; 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(MINXML,DFN,OUTXML)           ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
- ;
- ; MINXML is the Input XML Template, passed by name
- ; DFN is Patient IEN
- ; OUTXML is the resultant XML.
- ;
- ; 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, one medicine
- ;
- ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending
- ; meds 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).
- ; File for pending meds is 52.41
- ; Unfortuantely, API does not supply us with any useful info beyond
- ; the IEN in 52.41, and the Med Name, and route.
- ; So, most of the info is going to get pulled from 52.41.
- N MEDS,MAP
- K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
- D PEN^PSO5241(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
- N MEDCOUNT S MEDCOUNT=0
- N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING
- S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP
- S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY
- F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B"  D  ; FOR EACH MEDICATION IN THE LIST
- . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT  ; Dont' want refill request as a "pending" order
- . S MEDCOUNT=MEDCOUNT+1
- . I DEBUG W "RXIEN IS ",RXIEN,!
- . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
- . ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN CCRMEDS
- . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
- . I DEBUG W "MAP= ",MAP,!
- . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
- . S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
- . ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
- . S @MAP@("MEDISSUEDATETXT")="Issue Date"
- . ; Field 6 is "Effective date", and we pull it in timson format w/ I
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT")
- . ; Med never filled; next 4 fields are not applicable.
- . S @MAP@("MEDLASTFILLDATETXT")=""
- . S @MAP@("MEDLASTFILLDATE")=""
- . S @MAP@("MEDRXNOTXT")=""
- . S @MAP@("MEDRXNO")=""
- . S @MAP@("MEDTYPETEXT")="Medication"
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
- . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
- . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
- . ; NDC not supplied in API, but is rather trivial to obtain
- . ; MED(11) piece 1 has the IEN of the drug (file 50)
- . ; IEN is field 31 in the drug file.
- . ;
- . ; MEDIEN (node 11 in the returned output) might not necessarily be defined
- . ; It is not defined when a dose in not chosen in CPRS. There is a long
- . ; series of fields that depend on it. We will use If and Else to deal
- . ; with that
- . N MEDIEN S MEDIEN=$P(MED(11),U)
- . I +MEDIEN>0 D  ; start of if/else block
- . . ; 12/30/08: I will be using RxNorm for coding...
- . . ; 176.001 is the file for Concepts; 176.003 is the file for
- . . ; sources (i.e. for RxNorm Version)
- . . ;
- . . ; We need the VUID first for the National Drug File entry first
- . . ; We get the VUID of the drug, by looking up the VA Product entry
- . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
- . . ; Field 99.99 is the VUID.
- . . ;
- . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
- . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
- . . ; $$GET1^DIQ.
- . . ;
- . . ; I get the RxNorm name and version from the RxNorm Sources (file
- . . ; 176.003), by searching for "RXNORM", then get the data.
- . . D NDF^PSS50(MEDIEN,,,,,"NDF")
- . . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
- . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
- . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
- . . ;
- . . ; NDFIEN is not necessarily defined; it won't be if the drug
- . . ; is not matched to the national drug file (e.g. if the drug is
- . . ; new on the market, compounded, or is a fake drug [blue pill].
- . . ; To protect against failure, I will put an if/else block
- . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
- . . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
- . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
- . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
- . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
- . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
- . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
- . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
- . . ;
- . . E  S (RXNORM,RXNNAME,RXNVER)=""
- . . ; End if/else block
- . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
- . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
- . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
- . . ;
- . . S @MAP@("MEDBRANDNAMETEXT")=""
- . . 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; executed above.
- . . N CONCDATA
- . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
- . . ; and this will crash the call. So...
- . . I NDFIEN="" S CONCDATA=""
- . . E  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@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
- . . ; 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(MEDIEN,,,,,"QTY")
- . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
- . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
- . E  D
- . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
- . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
- . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
- . . S @MAP@("MEDBRANDNAMETEXT")=""
- . . S @MAP@("MEDSTRENGTHVALUE")=""
- . . S @MAP@("MEDSTRENGTHUNIT")=""
- . . S @MAP@("MEDFORMTEXT")=""
- . . S @MAP@("MEDCONCVALUE")=""
- . . S @MAP@("MEDCONCUNIT")=""
- . . S @MAP@("MEDSIZETEXT")=""
- . . S @MAP@("MEDQUANTITYVALUE")=""
- . . S @MAP@("MEDQUANTITYUNIT")=""
- . ; end of if/else block
- . ;
- . ; --- START OF DIRECTIONS ---
- . ; Sig data is not in any API. We obtain it using the IEN from
- . ; the PEN API to file 52.41. It's in field 3, which is a multiple.
- . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
- . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
- . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
- . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
- . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
- . ; DIRNUM will be first piece for IEN.
- . ; DIRNUM is the proper Sigline numer.
- . ; SIGDATA is the simplfied array. Subscripts are really field numbers
- . ; in subfile 52.413.
- . N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
- . F  S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM=""  D
- . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
- . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
- . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
- . . ; If this is an order for a refill; it's not really a new order; move on to next
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
- . . ; Invervals... again another call.
- . . ; The schedule is a free text field
- . . ; However, it gets translated by a call to the administration
- . . ; schedule file to see if that schedule exists.
- . . ; That's the same thing I am going to do.
- . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
- . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
- . . ; I looked), PSSFT is the name,
- . . ; and list is the ^TMP name to store the data in.
- . . ; Also, freqency may have "PRN" in it, so strip that out
- . . N FREQ S FREQ=SIGDATA(1)
- . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
- . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
- . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
- . . N INTERVAL
- . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
- . . E  D
- . . . N SUB S SUB=$O(SCHEDATA(0))
- . . . S INTERVAL=SCHEDATA(SUB,2)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
- . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
- . . N DUR S DUR=SIGDATA(2)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
- . . N DURUNIT S DURUNIT=$E(DUR)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
- . ;
- . ; --- END OF DIRECTIONS ---
- . ;
- . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
- . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
- . ; W @MAP@("MEDPTINSTRUCTIONS"),!
- . ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
- . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
- . ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
- . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
- . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
- . K @RESULT
- . D MAP^C0CXPATH(MINXML,MAP,RESULT)
- . ; D PARY^C0CXPATH(RESULT)
- . ; MAPPING DIRECTIONS
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
- . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
- . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
- . ; N MDZ1,MDZNA
- . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
- . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
- . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
- . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
- . I MEDFIRST D  ;
- . . S MEDFIRST=0 ; RESET FIRST FLAG
- . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
- . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
- N MEDTMP,MEDI
- D MISSING^C0CXPATH(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
- ;
Index: ccr/trunk/p/CCRMEDS3.m
===================================================================
--- ccr/trunk/p/CCRMEDS3.m	(revision 415)
+++ 	(revision )
@@ -1,230 +1,0 @@
-CCRMEDS3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista
- ;;0.1;CCDCCR;;;
- ;;Last Modified: Sun Jan 11 05:45:03 UTC 2009
- ; Copyright 2009 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(MINXML,DFN,OUTXML) ; Extract medications into provided xml template
- ;
- ; MINXML is the Input XML Template, passed by name
- ; DFN is Patient IEN
- ; OUTXML is the resultant XML.
- ;
- ; 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, one medicine
- ;
- ; Non-VA meds don't have an API. They are stored in file 55, subfile 52.2
- ; Discontinued meds are indicated by the presence of a value in fields
- ; 5 or 6 (STATUS 1 or 2, and DISCONTINUED DATE)
- ; Will use Fileman API GETS^DIQ
- ;
- N MEDS,MAP
- K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
- K NVA
- D GETS^DIQ(55,DFN,"52.2*","IE","NVA") ; Output in NVA in FDA array format.
- ; If NVA does not exist, then patient has no non-VA meds
- I $D(NVA)=0 S @OUTXML@(0)=0 QUIT
- ; Otherwise, we go on...
- M MEDS=NVA(55.05)
- ; We are done with NVA
- K NVA
- ;
- I DEBUG ZWR MEDS
- N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
- S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
- N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
- N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE
- F  S FDAIEN=$O(MEDS(FDAIEN)) Q:FDAIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
- . N MED M MED=MEDS(FDAIEN)
- . I MED(5,"I")!MED(6,"I") QUIT  ; If disconinued, we don't want to pull it.
- . S MEDCOUNT=MEDCOUNT+1
- . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
- . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
- . N RXIEN S RXIEN=$P(FDAIEN,",") ; First piece of FDAIEN is the number of the med for this patient
- . I DEBUG W "RXIEN IS ",RXIEN,!
- . I DEBUG W "MAP= ",MAP,!
- . S @MAP@("MEDOBJECTID")="MED_OUTSIDE"_MEDCOUNT ; MEDCOUNT FOR ID
- . S @MAP@("MEDISSUEDATETXT")="Documented Date"
- . ; Field 6 is "Effective date", and we pull it in timson format w/ I
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL(MED(11,"I"),"DT")
- . ; Med never filled; next 4 fields are not applicable.
- . S @MAP@("MEDLASTFILLDATETXT")=""
- . S @MAP@("MEDLASTFILLDATE")=""
- . S @MAP@("MEDRXNOTXT")=""
- . S @MAP@("MEDRXNO")=""
- . S @MAP@("MEDTYPETEXT")="Medication"
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
- . S @MAP@("MEDSTATUSTEXT")="ACTIVE" ; nearest status for pending meds
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_MED(12,"I")
- . S @MAP@("MEDPRODUCTNAMETEXT")=MED(.01,"E")
- . ; NDC is field 31 in the drug file.
- . ; The actual drug entry in the drug file (MEDIEN) is not necessarily supplied.
- . ; It' node 1, internal form.
- . N MEDIEN S MEDIEN=MED(1,"I")
- . I +MEDIEN D  ; start of if/else block
- . . ; 12/30/08: I will be using RxNorm for coding...
- . . ; 176.001 is the file for Concepts; 176.003 is the file for
- . . ; sources (i.e. for RxNorm Version)
- . . ;
- . . ; We need the VUID first for the National Drug File entry first
- . . ; We get the VUID of the drug, by looking up the VA Product entry
- . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
- . . ; Field 99.99 is the VUID.
- . . ;
- . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
- . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
- . . ; $$GET1^DIQ.
- . . ;
- . . ; I get the RxNorm name and version from the RxNorm Sources (file
- . . ; 176.003), by searching for "RXNORM", then get the data.
- . . D NDF^PSS50(MEDIEN,,,,,"NDF")
- . . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
- . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
- . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
- . . ;
- . . ; NDFIEN is not necessarily defined; it won't be if the drug
- . . ; is not matched to the national drug file (e.g. if the drug is
- . . ; new on the market, compounded, or is a fake drug [blue pill].
- . . ; To protect against failure, I will put an if/else block
- . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
- . . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
- . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
- . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
- . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
- . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
- . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
- . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
- . . ;
- . . E  S (RXNORM,RXNNAME,RXNVER)=""
- . . ; End if/else block
- . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
- . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
- . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
- . . ;
- . . S @MAP@("MEDBRANDNAMETEXT")=""
- . . 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; executed above.
- . . ;
- . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
- . . ; and this will crash the call. So...
- . . I NDFIEN="" S CONCDATA=""
- . . E  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@("MEDQUANTITYVALUE")=""  ; not provided for in Non-VA meds.
- . . ; 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(MEDIEN,,,,,"QTY")
- . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
- . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
- . E  D
- . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
- . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
- . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
- . . S @MAP@("MEDBRANDNAMETEXT")=""
- . . S @MAP@("MEDSTRENGTHVALUE")=""
- . . S @MAP@("MEDSTRENGTHUNIT")=""
- . . S @MAP@("MEDFORMTEXT")=""
- . . S @MAP@("MEDCONCVALUE")=""
- . . S @MAP@("MEDCONCUNIT")=""
- . . S @MAP@("MEDSIZETEXT")=""
- . . S @MAP@("MEDQUANTITYVALUE")=""
- . . S @MAP@("MEDQUANTITYUNIT")=""
- . ; End If/Else
- . ; --- START OF DIRECTIONS ---
- . ; Dosage is field 2, route is 3, schedule is 4
- . ; These are all free text fields, and don't point to any files
- . ; For that reason, I will use the field I never used before:
- . ; MEDDIRECTIONDESCRIPTIONTEXT
- . S DIRCNT=1 ; THERE IS ONLY ONE DIRECTION FOR OUTSIDE MEDS
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4"  ; means look in description text. See E2369-05.
- . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
- . ;
- . ; --- END OF DIRECTIONS ---
- . ;
- . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
- . I $D(MED(10,1)) D  ;
- . . S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field
- . E  S @MAP@("MEDPTINSTRUCTIONS")=""
- . I $D(MED(14,1)) D  ;
- . . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
- . E  S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
- . S @MAP@("MEDRFNO")=""
- . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
- . K @RESULT
- . D MAP^C0CXPATH(MINXML,MAP,RESULT)
- . ; D PARY^C0CXPATH(RESULT)
- . ; MAPPING DIRECTIONS
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
- . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
- . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
- . ; N MDZ1,MDZNA
- . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
- . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
- . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
- . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
- . I MEDFIRST D  ;
- . . S MEDFIRST=0 ; RESET FIRST FLAG
- . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
- . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
- N MEDTMP,MEDI
- D MISSING^C0CXPATH(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
- ;
Index: ccr/trunk/p/CCRMEDS4.m
===================================================================
--- ccr/trunk/p/CCRMEDS4.m	(revision 415)
+++ 	(revision )
@@ -1,178 +1,0 @@
-CCRMEDS4         ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08
- ;;0.1;CCDCCR;;;
- ; 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(MINXML,DFN,OUTXML)           ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
- ;
- ; MINXML is the Input XML Template, passed by name
- ; DFN is Patient IEN
- ; OUTXML is the resultant XML.
- ;
- ; MEDS is return array from API.
- ; MED is holds each array element from MEDS, one medicine
- ; MAP is a mapping variable map (store result) for each med
- ;
- ; Inpatient Meds will be extracted using this routine and and the one following.
- ; Inpatient Meds Unit Dose is going to be CCRMEDS4
- ; Inpatient Meds IVs is going to be CCRMEDS5
- ;
- ; We will use two Pharmacy ReEnginnering API's:
- ; PSS431^PSS55(DFN,PO,PSDATE,PEDATE,LIST) - provides most info
- ; PSS432^PSS55(DFN,PO,LIST) - provides schedule info
- ; For more information, see the PRE documentation at:
- ; http://www.va.gov/vdl/documents/Clinical/Pharm-Inpatient_Med/phar_1_api_r0807.pdf
- ; 
- ; Med data is stored in Unit Dose multiple of file 55, pharmacy patient
- ;
- N MEDS,MAP
- K ^TMP($J)
- D PSS431^PSS55(DFN,,,,"UD") ; Output is in ^TMP($J,"UD",*)
- I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT  ; No Meds - Quit
- ; Otherwise, we go on...
- M MEDS=^TMP($J,"UD")
- I DEBUG ZWR MEDS
- S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) 
- N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
- N I S I=0 
- F  S I=$O(MEDS("B",I)) Q:'I  D  ; For each medication in B index
- . N MED M MED=MEDS(I)
- . S MEDCOUNT=MEDCOUNT+1
- . S @MEDMAP@(0)=MEDCOUNT ; Update MedMap array counter
- . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
- . N RXIEN S RXIEN=MED(.01) ; Order Number
- . I DEBUG W "RXIEN IS ",RXIEN,!
- . I DEBUG W "MAP= ",MAP,!
- . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN 
- . S @MAP@("MEDISSUEDATETXT")="Order Date"
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
- . S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient
- . S @MAP@("MEDLASTFILLDATE")="" ; For Outpatient
- . S @MAP@("MEDRXNOTXT")="" ; For Outpatient
- . S @MAP@("MEDRXNO")="" ; For Outpatient
- . S @MAP@("MEDTYPETEXT")="Medication"
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
- . S @MAP@("MEDSTATUSTEXT")="ACTIVE" 
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)
- . S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01)
- . ; NDC is field 31 in the drug file.
- . ; The actual drug entry in the drug file is not necessarily supplied.
- . ; It' node 1, internal form.
- . N MEDIEN S MEDIEN=MED(1,"I")
- . S @MAP@("MEDPRODUCTNAMECODEVALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"")
- . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"")
- . S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"")
- . S @MAP@("MEDBRANDNAMETEXT")=""
- . I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE")
- . I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
- . S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"")
- . S @MAP@("MEDSTRENGTHUNIT")=$S($P(DOSEDATA(902),U,2),1:"")
- . ; 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 NDFDATA,CONCDATA
- . I $L(MEDIEN) D
- . . D NDF^PSS50(MEDIEN,,,,,"CONC")
- . . M NDFDATA=^TMP($J,"CONC",MEDIEN)
- . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
- . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
- . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
- . . ; and this will crash the call. So...
- . . I NDFIEN="" S CONCDATA=""
- . . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
- . E  S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors.
- . S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"")
- . S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"")
- . S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"")
- . S @MAP@("MEDQUANTITYVALUE")=""  ; not provided for in Non-VA meds.
- . ; 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
- . I $L(MEDIEN) D
- . . D DATA^PSS50(MEDIEN,,,,,"QTY")
- . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
- . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-   E  S @MAP@("MEDQUANTITYUNIT")=""
- . ;
- . ; --- START OF DIRECTIONS ---
- . ; Dosage is field 2, route is 3, schedule is 4
- . ; These are all free text fields, and don't point to any files
- . ; For that reason, I will use the field I never used before:
- . ; MEDDIRECTIONDESCRIPTIONTEXT
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4"  ; means look in description text. See E2369-05.
- . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""  
- . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""  
- . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""  
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
- . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
- . ;
- . ; --- END OF DIRECTIONS ---
- . ;
- . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
- . S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field
- . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
- . S @MAP@("MEDRFNO")=""
- . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
- . K @RESULT
- . D MAP^GPLXPATH(MINXML,MAP,RESULT)
- . ; D PARY^GPLXPATH(RESULT)
- . ; MAPPING DIRECTIONS
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
- . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
- . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
- . ; N MDZ1,MDZNA
- . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
- . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
- . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
- . . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
- . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
- . D:MEDCOUNT>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
- ;
Index: ccr/trunk/p/CCRMEDS6.m
===================================================================
--- ccr/trunk/p/CCRMEDS6.m	(revision 415)
+++ 	(revision )
@@ -1,324 +1,0 @@
-CCRMEDS6 ; WV/CCDCCR/SMH - Meds from RPMS: Outpatient Meds;01/10/09
- ;;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(MINXML,DFN,OUTXML)  ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
- ;
- ; MINXML and OUTXML are passed by name so globals can be used
- ; MINXML will contain only the medications skeleton 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.
- ;
- ; GETRXS^BEHORXFN(ARRAYNAME,DFN,DAYS) will be the the API used.
- ; This API has been developed by Medsphere for IHS for getting
- ; Medications from RPMS. It has most of what we need.
- ; API written by Doug Martin when he worked for Medsphere (thanks Doug!)
- ; -- ARRAYNAME is passed by name (required)
- ; -- DFN is passed by value (required)
- ; -- DAYS is passed by value (optional; if not passed defaults to 365)
- ; 
- ; Return:
- ; ~Type^PharmID^Drug^InfRate^StopDt^RefRem^TotDose^UnitDose^OrderID 
- ; ^Status^LastFill^Chronic^Issued^Rx #^Provider^ 
- ; Status Reason^DEA Handling
- ; 
- N MEDS,MEDS1,MAP
- D GETRXS^BEHORXFN("MEDS1",DFN,365) ; Days hard set to 365
- ; If MEDS1 is not defined, then no meds
- I '$D(MEDS1) S @OUTXML@(0)=0 QUIT
- I DEBUG ZWR MEDS1,MINXML
- N MEDCNT S MEDCNT=0 ; Med Count
- ; The next line is a super line. It goes through the array return
- ; and if the first characters are ~OP, it grabs the line.
- ; This means that line is for a dispensed Outpatient Med.
- ; That line has the metadata about the med that I need.
- ; The next lines, however many, are the med and the sig.
- ; I won't be using those because I have to get the sig parsed exactly.
- N J S J="" F  S J=$O(MEDS1(J)) Q:J=""  I $E(MEDS1(J),1,3)="~OP" S MEDCNT=MEDCNT+1 S MEDS(MEDCNT)=MEDS1(J)
- K MEDS1
- S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) ; this is the variable map
- S @MEDMAP@(0)=0 ; Initial count of meds
- S MEDCNT="" ; Initialize for $Order
- F  S MEDCNT=$O(MEDS(MEDCNT)) Q:MEDCNT=""  D  ; for each medication in the list
- . I DEBUG W "MEDCNT IS ",MEDCNT,!
- . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCNT))
- . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN CCRMEDS
- . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; increment total meds in var array
- . I DEBUG W "MAP= ",MAP,!
- . S @MAP@("MEDOBJECTID")="MED"_MEDCNT ; MEDCNT FOR ID
- . S @MAP@("MEDISSUEDATETXT")="Issue Date"
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,13))
- . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
- . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,11))
- . S @MAP@("MEDRXNOTXT")="Prescription Number"
- . S @MAP@("MEDRXNO")=$P(MEDS(MEDCNT),U,14)
- . S @MAP@("MEDTYPETEXT")="Medication"
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
- . S @MAP@("MEDSTATUSTEXT")=$P(MEDS(MEDCNT),U,10)
- . ; Provider only provided in API as text, not DUZ.
- . ; We need to get DUZ from filman file 52 (Prescription)
- . ; Field 4; IEN is Piece 2 of Meds stripped of trailing characters.
- . ; Note that I will use RXIEN several times later
- . N RXIEN S RXIEN=+$P(MEDS(MEDCNT),U,2)
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52,RXIEN,4,"I")
- . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MEDS(MEDCNT),U,3)
- . ; --- RxNorm Stuff 
- . ; 176.001 is the file for Concepts; 176.003 is the file for
- . ; sources (i.e. for RxNorm Version)
- . ; 
- . ; I use 176.001 for the Vista version of this routine (files 1-3)
- . ; Since IHS does not have VUID's, I will be getting RxNorm codes
- . ; using NDCs. My specially crafted index (sounds evil) named "NDC"
- . ; is in file 176.002. The file is called RxNorm NDC to VUID.
- . ; Except that I don't need the VUID, but it's there if I need it.
- . ; 
- . ; We obviously need the NDC. That is easily obtained from the prescription.
- . ; Field 27 in file 52
- . N NDC S NDC=$$GET1^DIQ(52,RXIEN,27,"I")
- . ; I discovered that file 176.002 might give you two codes for the NDC
- . ; One for the Clinical Drug, and one for the ingredient.
- . ; So the plan is to get the two RxNorm codes, and then find from
- . ; file 176.001 which one is the Clinical Drug.
- . ; ... I refactored this into GETRXN
- . N RXNORM,SRCIEN,RXNNAME,RXNVER
- . I +NDC,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
- . . S RXNORM=$$GETRXN(NDC)
- . . S SRCIEN=$$FIND1^DIC(176.003,,,"RXNORM","B")
- . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
- . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
- . ;
- . E  S (RXNORM,RXNNAME,RXNVER)=""
- . ; End if/else block
- . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
- . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
- . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
- . ; --- End RxNorm section
- . ;
- . ; Brand name is 52 field 6.5
- . S @MAP@("MEDBRANDNAMETEXT")=$$GET1^DIQ(52,RXIEN,6.5)
- . ;
- . ; Next I need Med Form (tab, cap etc), strength (250mg)
- . ; concentration for liquids (250mg/mL)
- . ; Since IHS does not have any of the new calls that 
- . ; Vista has, I will be doing a crosswalk:
- . ; File 52, field 6 is Drug IEN in file 50
- . ; File 50, field 22 is VA Product IEN in file 50.68
- . ; In file 50.68, I will get the following:
- . ; -- 1: Dosage Form
- . ; -- 2: Strength
- . ; -- 3: Units
- . ; -- 8: Dispense Units
- . ; -- Conc is 2 concatenated with 3
- . ; 
- . ; *** If Drug is not matched to NDF, then VA Product will be "" ***
- . ;
- . N MEDIEN S MEDIEN=$$GET1^DIQ(52,RXIEN,6,"I") ; Drug IEN in 50
- . N VAPROD S VAPROD=$$GET1^DIQ(50,MEDIEN,22,"I") ; VA Product in file 50.68
- . I +VAPROD D
- . . S @MAP@("MEDSTRENGTHVALUE")=$$GET1^DIQ(50.68,VAPROD,2)
- . . S @MAP@("MEDSTRENGTHUNIT")=$$GET1^DIQ(50.68,VAPROD,3)
- . . S @MAP@("MEDFORMTEXT")=$$GET1^DIQ(50.68,VAPROD,1)
- . . S @MAP@("MEDCONCVALUE")=@MAP@("MEDSTRENGTHVALUE")
- . . S @MAP@("MEDCONCUNIT")=@MAP@("MEDSTRENGTHUNIT")
- . E  D
- . . S @MAP@("MEDSTRENGTHVALUE")=""
- . . S @MAP@("MEDSTRENGTHUNIT")=""
- . . S @MAP@("MEDFORMTEXT")=""
- . . S @MAP@("MEDCONCVALUE")=""
- . . S @MAP@("MEDCONCUNIT")=""
- . ; End Strengh/Conc stuff
- . ;
- . ; Quantity is in the prescription, field 7
- . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52,RXIEN,7)
- . ; Dispense unit is in the drug file, field 14.5
- . S @MAP@("MEDQUANTITYUNIT")=$$GET1^DIQ(50,MEDIEN,14.5)
- . ;
- . ; --- START OF DIRECTIONS ---
- . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
- . ; we want the components.
- . ; It's in multiple 113 in the Prescription File (52)
- . ; #.01 DOSAGE ORDERED [1F] 			"20"
- . ; #1 DISPENSE UNITS PER DOSE [2N] 	"1"
- . ; #2 UNITS [3P:50.607] 				"MG"
- . ; #3 NOUN [4F]						"TABLET"
- . ; #4 DURATION [5F] 					"10D"
- . ; #5 CONJUNCTION [6S] 				"AND"
- . ; #6 ROUTE [7P:51.2] 				"ORAL"
- . ; #7 SCHEDULE [8F] 					"BID"
- . ; #8 VERB [9F] 						"TAKE"
- . ;
- . ; Will use GETS^DIQ to get fields.
- . ; Data comes out like this:
- . ; SAMINS(52.0113,"1,23,",.01)=20
- . ; SAMINS(52.0113,"1,23,",1)=1
- . ; SAMINS(52.0113,"1,23,",2)="MG"
- . ; SAMINS(52.0113,"1,23,",3)="TABLET"
- . ; SAMINS(52.0113,"1,23,",4)="5D"
- . ; SAMINS(52.0113,"1,23,",5)="THEN"
- . ;
- . N RAWDATA
- . D GETS^DIQ(52,RXIEN,"113*",,"RAWDATA","DIERR")
- . D:$D(DIERR) ^%ZTER  ; Log if there's an error in retrieving sig field
- . ; none the less, continue; some parts are retrievable.
- . N FMSIG M FMSIG=RAWDATA(52.0113) ; Merge into subfile...
- . K RAWDATA
- . N FMSIGNUM S FMSIGNUM="" ; Sigline number in fileman.
- . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
- . ; DIRCNT is the proper Sigline numer.
- . ; SIGDATA is the simplfied array. 
- . F  S FMSIGNUM=$O(FMSIG(FMSIGNUM)) Q:FMSIGNUM=""  D
- . . N DIRCNT S DIRCNT=$P(FMSIGNUM,",")
- . . N SIGDATA M SIGDATA=FMSIG(FMSIGNUM)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$G(SIGDATA(8))
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$G(SIGDATA(.01))
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=$G(SIGDATA(2))
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$G(SIGDATA(6))
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$G(SIGDATA(7))
- . . ; Invervals... again another call.
- . . ; In the wisdom of the original programmers, the schedule is a free text field
- . . ; However, it gets translated by a call to the administration schedule file
- . . ; to see if that schedule exists.
- . . ; That's the same thing I am going to do.
- . . ; Search B index of 51.1 (Admin Schedule) with schedule
- . . ; First, remove "PRN" if it exists (don't ask, that's how the file
- . . ; works; I wouldn't do it that way).
- . . N SCHNOPRN S SCHNOPRN=$G(SIGDATA(7))
- . . I SCHNOPRN["PRN" S SCHNOPRN=$E(SCHNOPRN,1,$F(SCHNOPRN,"PRN")-5)
- . . ; Super call below:
- . . ; 1=File 51.1 3=Field 2 (Frequency in Minutes)
- . . ; 4=Packed format, Exact Match 5=Lookup Value
- . . ; 6=# of entries to return 7=Index 10=Return Array
- . . ; 
- . . ; I do not account for the fact that two schedules can be
- . . ; spelled identically (ie duplicate entry). In that case,
- . . ; I get the first. That's just a bad pharmacy pkg maintainer.
- . . N C0C515
- . . D FIND^DIC(51.1,,"@;2","PX",SCHNOPRN,1,"B",,,"C0C515")
- . . N INTERVAL S INTERVAL="" ; Default
- . . ; If there are entries found, get it
- . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2) 
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
- . . ; Duration is 10M minutes, 10H hours, 10D for Days
- . . ; 10W for weeks, 10L for months. I smell $Select
- . . ; But we don't need to do that if there isn't a duration
- . . I +$G(SIGDATA(4)) D
- . . . N DURUNIT S DURUNIT=$E(SIGDATA(4),$L(SIGDATA(4))) ; get last char
- . . . N DURTXT S DURTXT=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"Days")
- . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=+SIGDATA(4)
- . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=DURTXT
- . . E  D
- . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=""
- . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$G(SIGDATA(4))["PRN"
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" ; when avail
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; not stored
- . . ; Another confusing line; I am pretty bad:
- . . ; If there is another entry in the FMSIG array (i.e. another line
- . . ; in the sig), set the direction count indicator.
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=""  ; Default
- . . S:+$O(FMSIG(FMSIGNUM)) @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRCNT
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$G(SIGDATA(5))
- . ;
- . ; --- END OF DIRECTIONS ---
- . ;
- . ; Med instructions is a WP field, thus the acrobatics
- . ; Notice buffer overflow protection set at 10,000 chars
- . ; -- 1. Med Patient Instructions
- . N MEDPTIN1 S MEDPTIN1=$$GET1^DIQ(52,RXIEN,115,,"MEDPTIN1")
- . N MEDPTIN2,J  S (MEDPTIN2,J)="" 
- . I $L(MEDPTIN1) F  S J=$O(@MEDPTIN1@(J)) Q:J=""  Q:$L(MEDPTIN2)>10000  S MEDPTIN2=MEDPTIN2_@MEDPTIN1@(J)_" "
- . S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2
- . K J
- . ; -- 2. Med Provider Instructions
- . N MEDPVIN1 S MEDPVIN1=$$GET1^DIQ(52,RXIEN,39,,"MEDPVIN1")
- . N MEDPVIN2,J S (MEDPVIN2,J)=""
- . I $L(MEDPVIN1) F  S J=$O(@MEDPVIN1@(J)) Q:J=""  Q:$L(MEDPVIN2)>10000  S MEDPVIN2=MEDPVIN2_@MEDPVIN1@(J)_" "
- . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MEDPVIN2
- . ;
- . ; Remaining refills
- . S @MAP@("MEDRFNO")=$P(MEDS(MEDCNT),U,6)
- . ; ------ END OF MAPPING
- . ;
- . ; ------ BEGIN XML INSERTION
- . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
- . K @RESULT
- . D MAP^C0CXPATH(MINXML,MAP,RESULT)
- . ; D PARY^C0CXPATH(RESULT)
- . ; MAPPING DIRECTIONS
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
- . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
- . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
- . ; N MDZ1,MDZNA
- . N DIRCNT S DIRCNT=""
- . I +$O(@MAP@("M","DIRECTIONS",DIRCNT)) D  ; IF THERE ARE DIRCTIONS
- . . F DIRCNT=$O(@MAP@("M","DIRECTIONS",DIRCNT)) D  ; FOR EACH DIRECTION
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",DIRCNT))
- . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
- . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
- . D:MEDCNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
- . D:MEDCNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
- N MEDTMP,MEDI
- D MISSING^C0CXPATH(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
- ;
-GETRXN(NDC) ; Extrinsic Function; PUBLIC; NDC to RxNorm
- ;; Get RxNorm Concept Number for a Given NDC
- ;
- S NDC=$TR(NDC,"-")  ; Remove dashes
- N RXNORM,C0CZRXN,DIERR
- D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR")
- I $D(DIERR) D ^%ZTER BREAK
- S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries
- N I S I=0
- F  S I=$O(C0CZRXN("DILIST",I)) Q:I=""  S RXNORM(I)=$P(C0CZRXN("DILIST",I,0),U,2)
- ; At this point, RxNorm(0) is # of entries; RxNorm(1...) are the entries
- ; If RxNorm(0) is 1, then we only have one entry, and that's it.
- I RXNORM(0)=1 QUIT RXNORM(1)  ; RETURN RXNORM(1)
- ; Otherwise, we need to find out which one is the semantic
- ; clinical drug. I built an index on 176.001 (RxNorm Concepts)
- ; for that purpose.
- I RXNORM(0)>1 D
- . S I=0
- . F  S I=$O(RXNORM(I)) Q:I=""  D  Q:$G(RXNORM)
- . . N RXNIEN S RXNIEN=$$FIND1^DIC(176.001,,,RXNORM(I),"SCD")
- . . I +$G(RXNIEN)=0 QUIT  ; try the next entry... 
- . . E  S RXNORM=RXNORM(I) QUIT  ; We found the right code
- QUIT +$G(RXNORM)  ; RETURN RXNORM; if we couldn't find a clnical drug, return with 0
-