extract RX codes for ACTIVE Outpatient MEDS

This commit is contained in:
george 2008-09-04 14:44:39 +00:00
parent c779e0dc5b
commit 9cb722d635
3 changed files with 48 additions and 2 deletions

View File

@ -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

View File

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

View File

@ -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)