From 9cb722d6355bc2e02133b2973456ccec34bbeaf9 Mon Sep 17 00:00:00 2001
From: george <george>
Date: Thu, 4 Sep 2008 14:44:39 +0000
Subject: [PATCH] extract RX codes for ACTIVE Outpatient MEDS

---
 p/GPLCCR.m   |  2 +-
 p/GPLMEDS.m  | 47 ++++++++++++++++++++++++++++++++++++++++++++++-
 p/GPLPROBS.m |  1 +
 3 files changed, 48 insertions(+), 2 deletions(-)

diff --git a/p/GPLCCR.m b/p/GPLCCR.m
index ea3575d..e89bfaf 100644
--- a/p/GPLCCR.m
+++ b/p/GPLCCR.m
@@ -44,7 +44,7 @@ XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
        I DIR="" S ODIR=@ODIRGLB
        N ZY
        S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
-       W $P(ZY,U,2)
+       W !,$P(ZY,U,2)
        Q
        ;
 CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
diff --git a/p/GPLMEDS.m b/p/GPLMEDS.m
index 546263c..1044fb8 100644
--- a/p/GPLMEDS.m
+++ b/p/GPLMEDS.m
@@ -59,15 +59,54 @@ EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
    . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
    . S @MEDVMAP@("MEDOBJECTID")="MED"_ZI ; UNIQUE OBJID FOR MEDS
    . 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@("PROBLEM")=""
+   . 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")=""
+   . 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")=""
@@ -110,3 +149,9 @@ EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
    . 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
+   ;
\ No newline at end of file
diff --git a/p/GPLPROBS.m b/p/GPLPROBS.m
index 38eee31..80d8d53 100644
--- a/p/GPLPROBS.m
+++ b/p/GPLPROBS.m
@@ -47,6 +47,7 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
           . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
           . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
           . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
+          . S @VMAP@("PROBLEMCODINGVERSION")=""
           . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
           . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
           . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)