VBECA3C ;HIOFO/BNT - VBECS Utility to parse XML for CPRS ;12/19/2003 01:00
;;2.0;VBEC;;Jun 05, 2015;Build 4
;
; Note: This routine supports data exchange with an FDA registered
; medical device. As such, it may not be changed in any way without
; prior written approval from the medical device manufacturer.
;
; Integration Agreements:
; Reference DBIA 4149 - M XML Parser
; Reference to EN^MXMLPRSE supported by IA #4149
; Reference to CHKNAME^XQ5 supported by IA #????
;
;
QUIT
;
EN(ARR,DOC) ;
N CBK,CNT
;W !!!,"Invoking XML Parser...",!!!
S OPTION=""
S VBECRES=$NA(^TMP("VBEC_OE_DATA",$J))
K @VBECRES
S (VBECTRHC,VBECTREQ,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC)=0
; Unit Type counters
SET (VBECUNC,VBECUNS,VBECUNA,VBECUND)=0
D SET(.CBK)
D EN^MXMLPRSE(DOC,.CBK,.OPTION)
M ARR=@VBECRES
;S CNT=""
;W !!!,"Parser Summary:",!!
;F S CNT=$O(CNT(CNT)) Q:CNT="" W CNT,":",?25,CNT(CNT),!
Q
; Direct entry of XML text from keyboard
; Terminate text entry with a solitary '^'
PASTE(OPTION) ;
N X,Y,GBL
S GBL=$NA(^TMP("VBEC_OE_XML",$J))
K @GBL
F X=1:1 D Q:Y="^"
.W X,"> "
.R Y:$G(DTIME,600),!
.E S Y="^"
.S:Y'="^" @GBL@(X)=Y
D EN(GBL,.OPTION)
K @GBL
Q
; Set the event interface entry points
SET(CBK) ;
K CBK
;F X=0:1 S Y=$P($T(SETX+X),";;",2) Q:Y="" D
;.S CBK(Y)=$E(Y,1,8)_"^VBECA3C"
S CBK("STARTELEMENT")="STELE^VBECA3C"
S CBK("ENDELEMENT")="ENELE^VBECA3C"
S CBK("CHARACTERS")="CHAR^VBECA3C"
Q
;
STELE(ELE,ATR) ; -- element start event handler
SET VBECELE=ELE
IF ELE="Patient" DO
. SET @VBECRES@("PATIENT")=$G(ATR("dfn"))_"^"_$G(ATR("firstName"))_"^"_$G(ATR("lastName"))_"^"_$G(ATR("ssn"))
. SET @VBECRES@("ABORH")=$G(ATR("abo"))_"^"_$G(ATR("rh"))
. QUIT
IF ELE="TransfusionReaction" DO
. SET VBECTRHC=VBECTRHC+1
. SET @VBECRES@("TRHX",VBECTRHC)=$G(ATR("type"))_"^"_$G(ATR("date"))
. QUIT
IF ELE="TransfusionRequirement" DO
. SET VBECTREQ=VBECTREQ+1
. SET @VBECRES@("TRREQ",VBECTREQ)=$G(ATR("modifier"))
. QUIT
IF ELE="Antibody" DO
. SET VBECABHC=VBECABHC+1
. SET @VBECRES@("ABHIS",VBECABHC)=$G(ATR("name"))
. QUIT
IF ELE="Unit" DO
. IF $G(ATR("status"))="C" DO
. . SET VBECUNC=VBECUNC+1
. . SET @VBECRES@("UNIT","C",VBECUNC)=$G(ATR("id"))_"^"_$G(ATR("product"))_"^"_$G(ATR("location"))_"^"_$G(ATR("expDate"))
. IF $G(ATR("status"))="S" DO
. . SET VBECUNS=VBECUNS+1
. . SET @VBECRES@("UNIT","S",VBECUNS)=$G(ATR("id"))_"^"_$G(ATR("product"))_"^"_$G(ATR("location"))_"^"_$G(ATR("expDate"))
. IF $G(ATR("status"))="A" DO
. . SET VBECUNA=VBECUNA+1
. . SET @VBECRES@("UNIT","A",VBECUNA)=$G(ATR("id"))_"^"_$G(ATR("product"))_"^"_$G(ATR("location"))_"^"_$G(ATR("expDate"))
. IF $G(ATR("status"))="D" DO
. . SET VBECUND=VBECUND+1
. . SET @VBECRES@("UNIT","D",VBECUND)=$G(ATR("id"))_"^"_$G(ATR("product"))_"^"_$G(ATR("location"))_"^"_$G(ATR("expDate"))
. QUIT
IF ELE="Specimen" DO
. SET @VBECRES@("SPECIMEN")=$G(ATR("expDate"))_"^"_$G(ATR("uid"))
. QUIT
IF ELE="Component" DO
. SET VBECOMP=$G(ATR("id"))
. SET VBECMSBC=0
. SET @VBECRES@(VBECOMP,"SPECIMEN")=$G(ATR("specimen"))
. QUIT
IF ELE="LabTest" DO
. SET VBECTSTC=VBECTSTC+1
. SET @VBECRES@(VBECOMP,"TEST",VBECTSTC)=$G(ATR("id"))_"^"_$G(ATR("name"))
. QUIT
IF ELE="Msbos" DO
. SET VBECMSBC=VBECMSBC+1
. SET @VBECRES@(VBECOMP,"MSBOS",VBECMSBC)=$G(ATR("name"))_"^"_$G(ATR("threshold"))
. QUIT
IF ELE="Surgery" DO
. SET VBECSRC=VBECSRC+1
. SET @VBECRES@("SURGERY",VBECSRC)=$G(ATR("name"))_"^"_$G(ATR("noBloodRequiredIndicator"))
QUIT
ENELE(ELE) ; -- element end event handler
KILL VBECNT
QUIT
;
CHAR(TEXT) ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECA3C 3667 printed Dec 13, 2024@02:43:47 Page 2
VBECA3C ;HIOFO/BNT - VBECS Utility to parse XML for CPRS ;12/19/2003 01:00
+1 ;;2.0;VBEC;;Jun 05, 2015;Build 4
+2 ;
+3 ; Note: This routine supports data exchange with an FDA registered
+4 ; medical device. As such, it may not be changed in any way without
+5 ; prior written approval from the medical device manufacturer.
+6 ;
+7 ; Integration Agreements:
+8 ; Reference DBIA 4149 - M XML Parser
+9 ; Reference to EN^MXMLPRSE supported by IA #4149
+10 ; Reference to CHKNAME^XQ5 supported by IA #????
+11 ;
+12 ;
+13 QUIT
+14 ;
EN(ARR,DOC) ;
+1 NEW CBK,CNT
+2 ;W !!!,"Invoking XML Parser...",!!!
+3 SET OPTION=""
+4 SET VBECRES=$NAME(^TMP("VBEC_OE_DATA",$JOB))
+5 KILL @VBECRES
+6 SET (VBECTRHC,VBECTREQ,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC)=0
+7 ; Unit Type counters
+8 SET (VBECUNC,VBECUNS,VBECUNA,VBECUND)=0
+9 DO SET(.CBK)
+10 DO EN^MXMLPRSE(DOC,.CBK,.OPTION)
+11 MERGE ARR=@VBECRES
+12 ;S CNT=""
+13 ;W !!!,"Parser Summary:",!!
+14 ;F S CNT=$O(CNT(CNT)) Q:CNT="" W CNT,":",?25,CNT(CNT),!
+15 QUIT
+16 ; Direct entry of XML text from keyboard
+17 ; Terminate text entry with a solitary '^'
PASTE(OPTION) ;
+1 NEW X,Y,GBL
+2 SET GBL=$NAME(^TMP("VBEC_OE_XML",$JOB))
+3 KILL @GBL
+4 FOR X=1:1
Begin DoDot:1
+5 WRITE X,"> "
+6 READ Y:$GET(DTIME,600),!
+7 IF '$TEST
SET Y="^"
+8 if Y'="^"
SET @GBL@(X)=Y
End DoDot:1
if Y="^"
QUIT
+9 DO EN(GBL,.OPTION)
+10 KILL @GBL
+11 QUIT
+12 ; Set the event interface entry points
SET(CBK) ;
+1 KILL CBK
+2 ;F X=0:1 S Y=$P($T(SETX+X),";;",2) Q:Y="" D
+3 ;.S CBK(Y)=$E(Y,1,8)_"^VBECA3C"
+4 SET CBK("STARTELEMENT")="STELE^VBECA3C"
+5 SET CBK("ENDELEMENT")="ENELE^VBECA3C"
+6 SET CBK("CHARACTERS")="CHAR^VBECA3C"
+7 QUIT
+8 ;
STELE(ELE,ATR) ; -- element start event handler
+1 SET VBECELE=ELE
+2 IF ELE="Patient"
Begin DoDot:1
+3 SET @VBECRES@("PATIENT")=$GET(ATR("dfn"))_"^"_$GET(ATR("firstName"))_"^"_$GET(ATR("lastName"))_"^"_$GET(ATR("ssn"))
+4 SET @VBECRES@("ABORH")=$GET(ATR("abo"))_"^"_$GET(ATR("rh"))
+5 QUIT
End DoDot:1
+6 IF ELE="TransfusionReaction"
Begin DoDot:1
+7 SET VBECTRHC=VBECTRHC+1
+8 SET @VBECRES@("TRHX",VBECTRHC)=$GET(ATR("type"))_"^"_$GET(ATR("date"))
+9 QUIT
End DoDot:1
+10 IF ELE="TransfusionRequirement"
Begin DoDot:1
+11 SET VBECTREQ=VBECTREQ+1
+12 SET @VBECRES@("TRREQ",VBECTREQ)=$GET(ATR("modifier"))
+13 QUIT
End DoDot:1
+14 IF ELE="Antibody"
Begin DoDot:1
+15 SET VBECABHC=VBECABHC+1
+16 SET @VBECRES@("ABHIS",VBECABHC)=$GET(ATR("name"))
+17 QUIT
End DoDot:1
+18 IF ELE="Unit"
Begin DoDot:1
+19 IF $GET(ATR("status"))="C"
Begin DoDot:2
+20 SET VBECUNC=VBECUNC+1
+21 SET @VBECRES@("UNIT","C",VBECUNC)=$GET(ATR("id"))_"^"_$GET(ATR("product"))_"^"_$GET(ATR("location"))_"^"_$GET(ATR("expDate"))
End DoDot:2
+22 IF $GET(ATR("status"))="S"
Begin DoDot:2
+23 SET VBECUNS=VBECUNS+1
+24 SET @VBECRES@("UNIT","S",VBECUNS)=$GET(ATR("id"))_"^"_$GET(ATR("product"))_"^"_$GET(ATR("location"))_"^"_$GET(ATR("expDate"))
End DoDot:2
+25 IF $GET(ATR("status"))="A"
Begin DoDot:2
+26 SET VBECUNA=VBECUNA+1
+27 SET @VBECRES@("UNIT","A",VBECUNA)=$GET(ATR("id"))_"^"_$GET(ATR("product"))_"^"_$GET(ATR("location"))_"^"_$GET(ATR("expDate"))
End DoDot:2
+28 IF $GET(ATR("status"))="D"
Begin DoDot:2
+29 SET VBECUND=VBECUND+1
+30 SET @VBECRES@("UNIT","D",VBECUND)=$GET(ATR("id"))_"^"_$GET(ATR("product"))_"^"_$GET(ATR("location"))_"^"_$GET(ATR("expDate"))
End DoDot:2
+31 QUIT
End DoDot:1
+32 IF ELE="Specimen"
Begin DoDot:1
+33 SET @VBECRES@("SPECIMEN")=$GET(ATR("expDate"))_"^"_$GET(ATR("uid"))
+34 QUIT
End DoDot:1
+35 IF ELE="Component"
Begin DoDot:1
+36 SET VBECOMP=$GET(ATR("id"))
+37 SET VBECMSBC=0
+38 SET @VBECRES@(VBECOMP,"SPECIMEN")=$GET(ATR("specimen"))
+39 QUIT
End DoDot:1
+40 IF ELE="LabTest"
Begin DoDot:1
+41 SET VBECTSTC=VBECTSTC+1
+42 SET @VBECRES@(VBECOMP,"TEST",VBECTSTC)=$GET(ATR("id"))_"^"_$GET(ATR("name"))
+43 QUIT
End DoDot:1
+44 IF ELE="Msbos"
Begin DoDot:1
+45 SET VBECMSBC=VBECMSBC+1
+46 SET @VBECRES@(VBECOMP,"MSBOS",VBECMSBC)=$GET(ATR("name"))_"^"_$GET(ATR("threshold"))
+47 QUIT
End DoDot:1
+48 IF ELE="Surgery"
Begin DoDot:1
+49 SET VBECSRC=VBECSRC+1
+50 SET @VBECRES@("SURGERY",VBECSRC)=$GET(ATR("name"))_"^"_$GET(ATR("noBloodRequiredIndicator"))
End DoDot:1
+51 QUIT
ENELE(ELE) ; -- element end event handler
+1 KILL VBECNT
+2 QUIT
+3 ;
CHAR(TEXT) ;
+1 QUIT
