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

rewrote control structure for parsing Med RPC

This commit is contained in:
george 2008-09-01 14:45:59 +00:00
parent dda0c9e43d
commit 68e078a1f5
1 changed files with 34 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
p/GPLMEDS.m
View File

@ -36,15 +36,28 @@ EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDICATIONS"))
S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
K @MEDTVMAP,@MEDTARYTMP
N DONE S DONE=0
F J=1:3 Q:'$D(MEDRSLT(J))!DONE D ; FOR EACH MEDICATION IN THE LIST
. I DEBUG W "J IS ",J,!
. S MEDVMAP=$NA(@MEDTVMAP@(J))
; 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
F ZI=1:1:ZA(0) D ; FOR EACH MED
. I DEBUG W "ZI IS ",ZI,!
. S MEDVMAP=$NA(@MEDTVMAP@(ZI))
. K @MEDVMAP
. I DEBUG W "VMAP= ",MEDVMAP,!
. S MEDPTMP=MEDRSLT(J) ; PULL OUT MEDICATION FROM RPC RETURN ARRAY
. S @MEDVMAP@("MEDOBJECTID")="MED"_J ; UNIQUE OBJID FOR MEDS
. ; PROCESSING FOR MEDS GOES HERE
. 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 @MEDVMAP@("MEDOBJECTID")="MED"_ZI ; UNIQUE OBJID FOR MEDS
. S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
. S @MEDVMAP@("MEDDATETIMEAGE")=""
. S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
@ -65,15 +78,17 @@ EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
. S @MEDVMAP@("MEDQUANTITYVALUE")=""
. S @MEDVMAP@("MEDQUANTITYUNIT")=""
. S @MEDVMAP@("MEDRFNO")=""
. I $D(MEDRSLT(J+1)) D ; IF SECOND LINE EXISTS
. . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(J+1)," *",2)
. I $D(MEDRSLT(J+2)) D ; IF THIRD LINE EXISTS
. . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=$P(MEDRSLT(J+2),"\ Sig: ",2)
. I $D(MEDRSLT(J+3)) D ; IF THERE IS ANOTHER LINE
. . I MEDRSLT(J+3)?1"t".E D ; CONTINUATION LINES
. . . I $D(MEDRSLT(J+6)) D ;
. . . . S J=J=3 ; SKIP THREE LINES TO NEXT MED
. . . E S DONE=1 ; ELSE NO MORE MEDS
. 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
. . S ZN=0 ; DON'T KNOW WHY
. . 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")=""
@ -81,13 +96,13 @@ EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
. S @MEDVMAP@("MEDDURATIONUNIT")=""
. S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
. S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
. S MEDARYTMP=$NA(@MEDTARYTMP@(J))
. S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
. K @MEDARYTMP
. D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
. I J=1 D ; FIRST ONE IS JUST A COPY
. I ZI=1 D ; FIRST ONE IS JUST A COPY
. . ; W "FIRST ONE",!
. . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
. I J>1 D ; AFTER THE FIRST, INSERT INNER XML
. I ZI>1 D ; AFTER THE FIRST, INSERT INNER XML
. . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
N MEDTMP,MEDI
D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS