iSharkFly-Open
/
VistA-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

intergrated CCRMEDS processing with GPLMEDS to get PENDING and Non-VA meds

This commit is contained in:
george 2008-09-22 20:12:52 +00:00
parent a15c65bf62
commit d484d7946e
3 changed files with 31 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
p/GPLMEDS.m
View File

@ -25,6 +25,14 @@ EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE ; 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 MEDS ARE PROCESSED IN EXTRACT^CCRMEDS, ALL OTHERS HERE
D EXTRACT^CCRMEDS(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 MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
D ACTIVE^ORWPS(.MEDRSLT,DFN) D ACTIVE^ORWPS(.MEDRSLT,DFN)
I '$D(MEDRSLT(1)) D ; NO MEDS FOR THIS PATIENT, EXIT I '$D(MEDRSLT(1)) D ; NO MEDS FOR THIS PATIENT, EXIT
@ -35,7 +43,7 @@ EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
M GPLMEDS=MEDRSLT M GPLMEDS=MEDRSLT
S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP")) S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
K @MEDTVMAP,@MEDTARYTMP I 'HASOP K @MEDTVMAP,@MEDTARYTMP
; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS ; 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 ; 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 N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
@ -53,12 +61,13 @@ EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS
F ZI=1:1:ZA(0) D ; FOR EACH MED F ZI=1:1:ZA(0) D ; FOR EACH MED
. I DEBUG W "ZI IS ",ZI,! . I DEBUG W "ZI IS ",ZI,!
. S MEDVMAP=$NA(@MEDTVMAP@(ZI)) . S MEDVMAP=$NA(@MEDTVMAP@(ZI+MEDCNT)) ; START PAST OP ACTIVE MEDS
. K @MEDVMAP . K @MEDVMAP
. I DEBUG W "VMAP= ",MEDVMAP,! . I DEBUG W "VMAP= ",MEDVMAP,!
. S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT . 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 . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
. S @MEDVMAP@("MEDOBJECTID")="MED"_ZI ; UNIQUE OBJID FOR MEDS . I $P(MEDPTMP,U,1)?1"~OP"&$P(MEDPTMP,"^",10)="ACTIVE" Q ; SKIP OP ACTIVE
. S @MEDVMAP@("MEDOBJECTID")="MED"_(ZI+MEDCNT) ; UNIQUE OBJID FOR MEDS
. I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")="" . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
. E S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE . E S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
. S @MEDVMAP@("MEDISSUEDATE")="" . S @MEDVMAP@("MEDISSUEDATE")=""
@ -139,10 +148,10 @@ EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
. S MEDARYTMP=$NA(@MEDTARYTMP@(ZI)) . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
. K @MEDARYTMP . K @MEDARYTMP
. D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP) . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
. I ZI=1 D ; FIRST ONE IS JUST A COPY . I ZI=1&('HASOP) D ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE
. . ; W "FIRST ONE",! . . ; W "FIRST ONE",!
. . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML) . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
. I ZI>1 D ; AFTER THE FIRST, INSERT INNER XML . E D ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
. . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP) . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
N MEDTMP,MEDI N MEDTMP,MEDI
D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS

1
p/GPLRIMA.m
View File

@ -100,6 +100,7 @@ SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
. ; W "POSTING PROBLEMS",! . ; W "POSTING PROBLEMS",!
I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS") I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
I $D(@SBASE@("MEDS",1)) D APOST("SATTR","RIMTBL","MEDS") I $D(@SBASE@("MEDS",1)) D APOST("SATTR","RIMTBL","MEDS")
; D PATD^GPLRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
W "ATTRIBUTES: ",SATTR,! W "ATTRIBUTES: ",SATTR,!
Q SATTR Q SATTR

16
p/GPLXPATH.m
View File

@ -447,6 +447,22 @@ XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
D H2ARY(XVRTN,"XVTMP") D H2ARY(XVRTN,"XVTMP")
Q Q
; ;
DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
;
N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
I DXIN="CCR" D ; NEED TO GO GET CCR TEMPLATE
. D LOAD^GPLCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
. S DXUSE="DTMP" ; DXUSE IS NAME
E I DXIN="CCD" D ; NEED TO GO GET CCD TEMPLATE
. D LOAD^GPLCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
. S DXUSE="DTMP" ; DXUSE IS NAME
E S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
D XVARS("DVARS",DXUSE) ; PULL OUT VARS
D PARY^GPLXPATH("DVARS") ;AND DISPLAY THEM
Q
;
TEST ; Run all the test cases TEST ; Run all the test cases
D TESTALL^GPLUNIT("GPLXPAT0") D TESTALL^GPLUNIT("GPLXPAT0")
Q Q