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

upgrades to actor extract and xpath processing for eRx

This commit is contained in:
george 2009-09-15 17:11:39 +00:00
parent 4e868108b6
commit 6a3c31c484
2 changed files with 15 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
p/C0CACTOR.m
View File

@ -84,9 +84,18 @@ EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
; ;
PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,! I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
N AMAP,ZX ;GPL SEPARATED EXTRACT FROM MAP FOR PROCESSING PATIENTS - TO MAKE
; CODE REUSABLE FROM ERX
N AMAP
S AMAP=$NA(^TMP($J,"AMAP")) S AMAP=$NA(^TMP($J,"AMAP"))
K @AMAP K @AMAP
D PEXTRACT(AMAP,AIEN,AOID) ;EXTRACT THE PATIENT ACTOR
D MAP(INXML,AMAP,OUTXML) ;MAP TO XML
K @AMAP ; CLEAN UP BEHIND US
Q
;
PEXTRACT(AMAP,AIEN,AOID) ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME
N ZX
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN) S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN)
S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN) S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN)
@ -138,6 +147,9 @@ PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
S @AMAP@("ACTORIEN")=AIEN S @AMAP@("ACTORIEN")=AIEN
S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
Q
;
MAP(INXML,AMAP,OUTXML) ;MAP ANY ACTOR TO XML
D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
Q Q
; ;

3
p/C0CXPATH.m
View File

@ -225,6 +225,7 @@ INDEX(IZXML,VDX,NOINX,TEMPLATE) ; parse XML in IZXML and produce an XPATH index
S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX
I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX
S C0CSTK(0)=0 ; INITIALIZE STACK S C0CSTK(0)=0 ; INITIALIZE STACK
K LKASD ; KILL LOOKASIDE ARRAY
D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES
F I=1:1:LCNT D ; PROCESS THE ENTIRE ARRAY F I=1:1:LCNT D ; PROCESS THE ENTIRE ARRAY
. S LINE=@IZXML@(I) . S LINE=@IZXML@(I)
@ -308,7 +309,7 @@ MKLASD(OUTBUF,INARY) ; CREATE A LOOKASIDE BUFFER FOR MULTILPLES
S ZI="" S ZI=""
F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; FOR EACH KIND OF MULTIPLE F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; FOR EACH KIND OF MULTIPLE
. S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE . S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE
. F S ZN=$O(@IZXML@(ZN),-1) Q:ZN="" I $P(@IZXML@(ZN),"<"_ZI,2)=">" Q ; . F S ZN=$O(@IZXML@(ZN),-1) Q:ZN="" I $E($P(@IZXML@(ZN),"<"_ZI,2),1,1)=">" Q ;
. S OUTBUF(ZI,ZN)="" . S OUTBUF(ZI,ZN)=""
S ZA=1,ZI="",ZN="" S ZA=1,ZI="",ZN=""
F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; ADDING THE COUNT FOR THE MULIPLES [x] F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; ADDING THE COUNT FOR THE MULIPLES [x]