VBECA5B ;HIOFO/BNT/RLM - VBECS COMPONENT CLASS LOOKUP FOR SURGERY ;11/24/2004
;;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 DIBA 4622 for VBECS Blood Products
; Reference to EN^MXMLPRSE supported by IA #4149
; Reference to CHKNAME^XQ5 supported by IA #????
;
QUIT
;
COMPCL ; -- Retrieves XML from VBECS
Q:'$D(X)
K ^TMP("VBECA5B",$J),^TMP("VBECA5B1",$J) S VBECX=X
D INITV^VBECRPCC("VBECS Blood Products")
S VBECY="^TMP(""VBECA5B"",$J)",VBECPRMS("RESULTS")="^TMP(""VBECA5B1"",$J)"
S VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
D PARSE^VBECRPC1(.VBECPRMS,VBECY)
D EN(.ARR,VBECY)
SEL ;
K C,DIR S X=VBECX
;S DIR("A")="",DIR(0)="FA^2:40",DIR("?")="^D LIST^VBECA5B",DIR("??")="^D LIST^VBECA5B" D ^DIR I $D(DIRUT) S X="" Q ;Uncomment for testing
I $D(^TMP("VBEC_BP_DATA",$J,"BLOOD PRODUCT","B",X)) Q
S A=X F I=1:1 S A=$O(^TMP("VBEC_BP_DATA",$J,"BLOOD PRODUCT","B",A)) Q:$E(A,1,$L(X))'=X D
. S B="" F S B=$O(^TMP("VBEC_BP_DATA",$J,"BLOOD PRODUCT","B",A,B)) Q:B="" S C(I,A)=B
I I=2 S Y=$O(C(1,"")) W $E(Y,$L(X)+1,999) S X=Y Q
S (A,B)="" F S A=$O(C(A)) Q:'A W !?5,A,?9 F S B=$O(C(A,B)) Q:B="" W B
SEL1 K DIR S DIR("A")="CHOOSE 1-"_(I-1)_":",DIR(0)="LA^1:"_(I-1),DIR("?")="^D LIST^VBECA5B",DIR("??")="^D LIST^VBECA5B"
D ^DIR I $D(DIRUT) S X="" Q
S X=$O(C(X,""))
EXIT ;
K A,B,DIRUT,EVT,I,OPTION,VBECABHC,VBECLN,VBECMSBC,VBECPRMS,VBECRES
K VBECL,VBECSRC,VBECSTAT,VBECTRHC,VBECTSTC,VBECUNA,VBECUNC,VBECUND
K VBECUNS,VBECY,Y
Q
LIST ;Lists components for ? or ??. Also replaces LIST66 and OUT66
D INITV^VBECRPCC("VBECS Blood Products")
S VBECY="^TMP(""VBECA5BL"",$J)",VBECPRMS("RESULTS")="^TMP(""VBECA5B1L"",$J)"
S VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
D PARSE^VBECRPC1(.VBECPRMS,VBECY)
N CBK,CNT
S OPTION="",VBECRES=$NA(^TMP("VBEC_BP_LIST",$J))
K @VBECRES
S (VBECLN,VBECTRHC,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC,VBECUNC,VBECUNS,VBECUNA,VBECUND)=0
K CBK
S CBK("STARTELEMENT")="STELE^VBECA5B"
S CBK("ENDELEMENT")="ENELE^VBECA5B"
S CBK("CHARACTERS")="CHAR^VBECA5B"
D EN^MXMLPRSE(VBECY,.CBK,.OPTION)
S VBECLI=0 F S VBECLI=$O(^TMP("VBEC_BP_LIST",$J,"BLOOD PRODUCT",VBECLI)) Q:'VBECLI W !?5,$P(^(VBECLI),"^")," - ",$P(^(VBECLI),"^",2)
Q
;S A="" F VBECL=1:1 S A=$O(^TMP("VBEC_BP_DATA",$J,"BLOOD PRODUCT",A)) Q:'A D I '(VBECL#5) S DIR(0)="E" D ^DIR Q:$D(DIRUT)
; . W !,$P(^TMP("VBEC_BP_DATA",$J,"BLOOD PRODUCT",A),"^")," ",$P(^TMP("VBEC_BP_DATA",$J,"BLOOD PRODUCT",A),"^",2)
Q
EN(ARR,DOC) ;
N CBK,CNT
S OPTION="",VBECRES=$NA(^TMP("VBEC_BP_DATA",$J))
K @VBECRES
S (VBECLN,VBECTRHC,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC,VBECUNC,VBECUNS,VBECUNA,VBECUND)=0
D SET(.CBK)
D EN^MXMLPRSE(DOC,.CBK,.OPTION)
M ARR=@VBECRES
Q
SET(CBK) ;
K CBK
S CBK("STARTELEMENT")="STELE^VBECA5B"
S CBK("ENDELEMENT")="ENELE^VBECA5B"
S CBK("CHARACTERS")="CHAR^VBECA5B"
Q
;
STELE(ELE,ATR) ; -- element start event handler
I ELE="ComponentClass" D
. S VBECLN=VBECLN+1,@VBECRES@("BLOOD PRODUCT",VBECLN)=$G(ATR("name"))_"^"_$G(ATR("shortName"))
. S @VBECRES@("BLOOD PRODUCT","B",$G(ATR("name")),VBECLN)=""
. S @VBECRES@("BLOOD PRODUCT","B",$G(ATR("shortName")),VBECLN)=""
Q
ENELE(ELE) ; -- element end event handler
Q
;
CHAR(TEXT) ;
Q
ZEOR ;VBECA5B
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECA5B 3493 printed Sep 23, 2025@20:19:57 Page 2
VBECA5B ;HIOFO/BNT/RLM - VBECS COMPONENT CLASS LOOKUP FOR SURGERY ;11/24/2004
+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 DIBA 4622 for VBECS Blood Products
+9 ; Reference to EN^MXMLPRSE supported by IA #4149
+10 ; Reference to CHKNAME^XQ5 supported by IA #????
+11 ;
+12 QUIT
+13 ;
COMPCL ; -- Retrieves XML from VBECS
+1 if '$DATA(X)
QUIT
+2 KILL ^TMP("VBECA5B",$JOB),^TMP("VBECA5B1",$JOB)
SET VBECX=X
+3 DO INITV^VBECRPCC("VBECS Blood Products")
+4 SET VBECY="^TMP(""VBECA5B"",$J)"
SET VBECPRMS("RESULTS")="^TMP(""VBECA5B1"",$J)"
+5 SET VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
+6 DO PARSE^VBECRPC1(.VBECPRMS,VBECY)
+7 DO EN(.ARR,VBECY)
SEL ;
+1 KILL C,DIR
SET X=VBECX
+2 ;S DIR("A")="",DIR(0)="FA^2:40",DIR("?")="^D LIST^VBECA5B",DIR("??")="^D LIST^VBECA5B" D ^DIR I $D(DIRUT) S X="" Q ;Uncomment for testing
+3 IF $DATA(^TMP("VBEC_BP_DATA",$JOB,"BLOOD PRODUCT","B",X))
QUIT
+4 SET A=X
FOR I=1:1
SET A=$ORDER(^TMP("VBEC_BP_DATA",$JOB,"BLOOD PRODUCT","B",A))
if $EXTRACT(A,1,$LENGTH(X))'=X
QUIT
Begin DoDot:1
+5 SET B=""
FOR
SET B=$ORDER(^TMP("VBEC_BP_DATA",$JOB,"BLOOD PRODUCT","B",A,B))
if B=""
QUIT
SET C(I,A)=B
End DoDot:1
+6 IF I=2
SET Y=$ORDER(C(1,""))
WRITE $EXTRACT(Y,$LENGTH(X)+1,999)
SET X=Y
QUIT
+7 SET (A,B)=""
FOR
SET A=$ORDER(C(A))
if 'A
QUIT
WRITE !?5,A,?9
FOR
SET B=$ORDER(C(A,B))
if B=""
QUIT
WRITE B
SEL1 KILL DIR
SET DIR("A")="CHOOSE 1-"_(I-1)_":"
SET DIR(0)="LA^1:"_(I-1)
SET DIR("?")="^D LIST^VBECA5B"
SET DIR("??")="^D LIST^VBECA5B"
+1 DO ^DIR
IF $DATA(DIRUT)
SET X=""
QUIT
+2 SET X=$ORDER(C(X,""))
EXIT ;
+1 KILL A,B,DIRUT,EVT,I,OPTION,VBECABHC,VBECLN,VBECMSBC,VBECPRMS,VBECRES
+2 KILL VBECL,VBECSRC,VBECSTAT,VBECTRHC,VBECTSTC,VBECUNA,VBECUNC,VBECUND
+3 KILL VBECUNS,VBECY,Y
+4 QUIT
LIST ;Lists components for ? or ??. Also replaces LIST66 and OUT66
+1 DO INITV^VBECRPCC("VBECS Blood Products")
+2 SET VBECY="^TMP(""VBECA5BL"",$J)"
SET VBECPRMS("RESULTS")="^TMP(""VBECA5B1L"",$J)"
+3 SET VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
+4 DO PARSE^VBECRPC1(.VBECPRMS,VBECY)
+5 NEW CBK,CNT
+6 SET OPTION=""
SET VBECRES=$NAME(^TMP("VBEC_BP_LIST",$JOB))
+7 KILL @VBECRES
+8 SET (VBECLN,VBECTRHC,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC,VBECUNC,VBECUNS,VBECUNA,VBECUND)=0
+9 KILL CBK
+10 SET CBK("STARTELEMENT")="STELE^VBECA5B"
+11 SET CBK("ENDELEMENT")="ENELE^VBECA5B"
+12 SET CBK("CHARACTERS")="CHAR^VBECA5B"
+13 DO EN^MXMLPRSE(VBECY,.CBK,.OPTION)
+14 SET VBECLI=0
FOR
SET VBECLI=$ORDER(^TMP("VBEC_BP_LIST",$JOB,"BLOOD PRODUCT",VBECLI))
if 'VBECLI
QUIT
WRITE !?5,$PIECE(^(VBECLI),"^")," - ",$PIECE(^(VBECLI),"^",2)
+15 QUIT
+16 ;S A="" F VBECL=1:1 S A=$O(^TMP("VBEC_BP_DATA",$J,"BLOOD PRODUCT",A)) Q:'A D I '(VBECL#5) S DIR(0)="E" D ^DIR Q:$D(DIRUT)
+17 ; . W !,$P(^TMP("VBEC_BP_DATA",$J,"BLOOD PRODUCT",A),"^")," ",$P(^TMP("VBEC_BP_DATA",$J,"BLOOD PRODUCT",A),"^",2)
+18 QUIT
EN(ARR,DOC) ;
+1 NEW CBK,CNT
+2 SET OPTION=""
SET VBECRES=$NAME(^TMP("VBEC_BP_DATA",$JOB))
+3 KILL @VBECRES
+4 SET (VBECLN,VBECTRHC,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC,VBECUNC,VBECUNS,VBECUNA,VBECUND)=0
+5 DO SET(.CBK)
+6 DO EN^MXMLPRSE(DOC,.CBK,.OPTION)
+7 MERGE ARR=@VBECRES
+8 QUIT
SET(CBK) ;
+1 KILL CBK
+2 SET CBK("STARTELEMENT")="STELE^VBECA5B"
+3 SET CBK("ENDELEMENT")="ENELE^VBECA5B"
+4 SET CBK("CHARACTERS")="CHAR^VBECA5B"
+5 QUIT
+6 ;
STELE(ELE,ATR) ; -- element start event handler
+1 IF ELE="ComponentClass"
Begin DoDot:1
+2 SET VBECLN=VBECLN+1
SET @VBECRES@("BLOOD PRODUCT",VBECLN)=$GET(ATR("name"))_"^"_$GET(ATR("shortName"))
+3 SET @VBECRES@("BLOOD PRODUCT","B",$GET(ATR("name")),VBECLN)=""
+4 SET @VBECRES@("BLOOD PRODUCT","B",$GET(ATR("shortName")),VBECLN)=""
End DoDot:1
+5 QUIT
ENELE(ELE) ; -- element end event handler
+1 QUIT
+2 ;
CHAR(TEXT) ;
+1 QUIT
ZEOR ;VBECA5B
