Index: ccr/trunk/p/CCRMEDS.m
===================================================================
--- ccr/trunk/p/CCRMEDS.m	(revision 185)
+++ ccr/trunk/p/CCRMEDS.m	(revision 186)
@@ -1,182 +1,182 @@
 CCRMEDS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08  14:33
-   ;;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
-   ;
+ ;;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(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
-   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=@MEDOUTXML@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-   . 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^GPLXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE
-   . E  D CP^GPLXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY
-   . S MEDCNT=@MEDOUTXML@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-   . W "HAS OP PENDING MEDS",!
-   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 GPLMEDS=MEDRSLT
-   S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-   S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-   I 'HASOP K @MEDTVMAP,@MEDTARYTMP
-   ; 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,!
-   . S MEDVMAP=$NA(@MEDTVMAP@(ZI+MEDCNT)) ; START PAST OP ACTIVE MEDS
-   . K @MEDVMAP
-   . I DEBUG W "VMAP= ",MEDVMAP,!
-   . 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 @MEDVMAP@("MEDOBJECTID")="MED"_(ZI+MEDCNT) ; UNIQUE OBJID FOR MEDS
-   . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
-   . E  S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($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@("MEDSIZETEXT")=""
-   . 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^GPLXPATH(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^GPLXPATH(MEDARYTMP,MEDOUTXML)
-   . E  D  ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
-   . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
-   N MEDTMP,MEDI
-   D MISSING^GPLXPATH(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
-   ;
+ ;
+ ; 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
+ 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=@MEDOUTXML@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
+ . 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^GPLXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE
+ . E  D CP^GPLXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY
+ . S MEDCNT=@MEDOUTXML@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
+ . W "HAS OP PENDING MEDS",!
+ 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 GPLMEDS=MEDRSLT
+ S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
+ S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
+ I 'HASOP K @MEDTVMAP,@MEDTARYTMP
+ ; 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,!
+ . S MEDVMAP=$NA(@MEDTVMAP@(ZI+MEDCNT)) ; START PAST OP ACTIVE MEDS
+ . K @MEDVMAP
+ . I DEBUG W "VMAP= ",MEDVMAP,!
+ . 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 @MEDVMAP@("MEDOBJECTID")="MED"_(ZI+MEDCNT) ; UNIQUE OBJID FOR MEDS
+ . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
+ . E  S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($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@("MEDSIZETEXT")=""
+ . 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^GPLXPATH(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^GPLXPATH(MEDARYTMP,MEDOUTXML)
+ . E  D  ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
+ . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
+ N MEDTMP,MEDI
+ D MISSING^GPLXPATH(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
-   ;
+ ; 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
+ ;
