extract RX codes for ACTIVE Outpatient MEDS

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

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
+   ;

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)