VBECA1B ;HIOFO/BNT - VBECS Patient Data APIs ; 01/21/05 8:30am
;;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 to ^DIC supported by IA #10006
; Reference to file 200 supported by IA #10035
; Reference to $$CHARCHK^XOBVLIB supported by IA #4090
; Reference to EN^MXMLPRSE supported by IA #4149
; Reference to ^DPT( supported by IA #10035
;
QUIT
;
; ----------------------------------------------------------
; Private Method supports IA 4624
; ----------------------------------------------------------
ABORH(DFN,VBECTYP) ; Returns VBECS Patient ABO Group and Rh Type
; Input: DFN = PATIENT file (#2) IEN
; VBECTYP = "ABORH" or "ABO" or "RH" as needed.
IF '$D(^DPT(DFN,0)) S ARR("ERROR")="1^Invalid or Missing Patient Identifier" QUIT ARR("ERROR")
IF VBECTYP'="ABORH"&(VBECTYP'="ABO")&(VBECTYP'="RH") S ARR("ERROR")="1^Invalid Input" QUIT ARR("ERROR")
K ^TMP("VBECAPI",$J),^TMP("VBECAPI1",$J),ARR1
D INITV^VBECRPCC("VBECS Patient ABO_RH")
S VBECY="^TMP(""VBECAPI"",$J)",VBECPRMS("RESULTS")="^TMP(""VBECAPI1"",$J)"
IF +VBECPRMS("ERROR") S ARR("ERROR")=VBECPRMS("ERROR") Q ARR("ERROR")
SET VBECPRMS("PARAMS",1,"TYPE")="STRING"
SET VBECPRMS("PARAMS",1,"VALUE")=$$CHARCHK^XOBVLIB(DFN)
S VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
D PARSE^VBECRPC1(.VBECPRMS,VBECY)
I $D(@VBECY@("ERROR")) SET ARR("ERROR")="1^"_@VBECY@("ERROR") QUIT ARR("ERROR")
D ABOEN(.ARR,VBECY)
K ^TMP("VBECAPI",$J),^TMP("VBECAPI1",$J),ARR1
;K OPTION,VBECABHC,VBECLN,VBECMSBC,VBECPRMS,VBECRES
K VBECSRC,VBECSTAT,VBECTRHC,VBECTSTC,VBECUNA,VBECUNC,VBECUND
K VBECUNS,VBECY
Q $G(@VBECTYP)
ABOEN(ARR,DOC) ;
N CBK,CNT
S OPTION="",VBECRES=$NA(ARR1("API"))
K @VBECRES
S (VBECLN,VBECTRHC,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC,VBECUNC,VBECUNS,VBECUNA,VBECUND)=0
D ABOSET(.CBK)
D EN^MXMLPRSE(DOC,.CBK,.OPTION)
Q
ABOSET(CBK) ;
K CBK
S CBK("STARTELEMENT")="ABOSTELE^VBECA1B1"
S CBK("ENDELEMENT")="ENELE^VBECA1B1"
S CBK("CHARACTERS")="CHAR^VBECA1B1"
Q
;
; ----------------------------------------------------------
; Private Method supports IA 4626
; ----------------------------------------------------------
TRRX(DFN) ; Returns VBECS Patient Transfusion Reaction History
K ^TMP("VBECAPI",$J),^TMP("VBECAPI1",$J)
D INITV^VBECRPCC("VBECS Patient TRRX")
S VBECY="^TMP(""VBECAPI"",$J)",VBECPRMS("RESULTS")="^TMP(""VBECAPI1"",$J)"
IF +VBECPRMS("ERROR") S ARR("ERROR")=VBECPRMS("ERROR") Q
SET VBECPRMS("PARAMS",1,"TYPE")="STRING"
SET VBECPRMS("PARAMS",1,"VALUE")=$$CHARCHK^XOBVLIB(DFN)
S VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
D PARSE^VBECRPC1(.VBECPRMS,VBECY)
D TRRXEN(.ARR,VBECY)
I '$D(ARR("TRRX")) S ARR("TRRX")=""
Q
;
TRRXEN(ARR,DOC) ;
N CBK,CNT
S OPTION="",VBECRES=$NA(^TMP("VBECA1B",$J))
K @VBECRES
S (VBECLN,VBECTRHC,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC,VBECUNC,VBECUNS,VBECUNA,VBECUND)=0
D TRRXSET(.CBK)
D EN^MXMLPRSE(DOC,.CBK,.OPTION)
M ARR("TRRX")=@VBECRES
K VBECABHC,VBECLN,VBECMSBC,VBECPRMS,VBECRES,VBECSRC,VBECSTAT
K VBECTRHC,VBECTSTC,VBECUNA,VBECUNC,VBECUND,VBECUNS,VBECY
K ^TMP("VBECAPI",$J),^TMP("VBECAPI1",$J)
Q
;
TRRXSET(CBK) ;
K CBK
S CBK("STARTELEMENT")="TRSTELE^VBECA1B1"
S CBK("ENDELEMENT")="ENELE^VBECA1B1"
S CBK("CHARACTERS")="CHAR^VBECA1B1"
Q
;
; ----------------------------------------------------------
; Private Method supports IA 4625
; ----------------------------------------------------------
ABID(DFN) ; Returns VBECS Patient Antibodies Identified
D INITV^VBECRPCC("VBECS Patient ABID")
S VBECY="^TMP(""VBECAPI"",$J)",VBECPRMS("RESULTS")="^TMP(""VBECAPI1"",$J)"
K @VBECY,@VBECPRMS("RESULTS")
IF +VBECPRMS("ERROR") S ARR("ERROR")=VBECPRMS("ERROR") Q
SET VBECPRMS("PARAMS",1,"TYPE")="STRING"
SET VBECPRMS("PARAMS",1,"VALUE")=$$CHARCHK^XOBVLIB(DFN)
S VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
D PARSE^VBECRPC1(.VBECPRMS,VBECY)
D ABIDEN(.ARR,VBECY)
;K @VBECY,@VBECPRMS("RESULTS")
K ARR1,ATR,ATR,CBK,CNT,DFN,DOC,ELE,OPTION,TEXT,VBECABHC,VBECLN
K VBECMSBC,VBECPRMS,VBECRES,VBECSRC,VBECSTAT,VBECTRHC,VBECTSTC
K VBECUNA,VBECUNC,VBECUND,VBECUNS,VBECY
Q
;
ABIDEN(ARR,DOC) ;
N CBK,CNT
S OPTION="",VBECRES=$NA(^TMP("VBECA1B",$J))
K @VBECRES
S (VBECLN,VBECTRHC,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC,VBECUNC,VBECUNS,VBECUNA,VBECUND)=0
D ABSET(.CBK)
D EN^MXMLPRSE(DOC,.CBK,.OPTION)
M ARR("ABID")=@VBECRES
Q
;
ABSET(CBK) ;
K CBK
S CBK("STARTELEMENT")="ABSTELE^VBECA1B1"
S CBK("ENDELEMENT")="ENELE^VBECA1B1"
S CBK("CHARACTERS")="CHAR^VBECA1B1"
Q
;
; ----------------------------------------------------------
; Private Method supports IA 4620
; ----------------------------------------------------------
AVUNIT(TMPLOC,DFN) ; Returns VBECS Patient Available Units
; Input variable;
; TMPLOC = Node in ^TMP to be used for output data array
; DFN = Internal number of patient
;
; Output is data array:
; ^TMP(TMPLOC,$J,n)
;
Q:$G(TMPLOC)=""
Q:'$G(DFN)
K ^TMP("VBECAPI",$J),^TMP("VBECAPI1",$J),^TMP(TMPLOC,$J)
D INITV^VBECRPCC("VBECS Patient Available Units")
S VBECY="^TMP(""VBECAPI"",$J)",VBECPRMS("RESULTS")="^TMP(""VBECAPI1"",$J)"
IF +VBECPRMS("ERROR") S ARR("ERROR")=VBECPRMS("ERROR") Q
SET VBECPRMS("PARAMS",1,"TYPE")="STRING"
SET VBECPRMS("PARAMS",1,"VALUE")=$$CHARCHK^XOBVLIB(DFN)
S VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
D PARSE^VBECRPC1(.VBECPRMS,VBECY)
D AVUEN(.ARR,VBECY)
I '$D(ARR("UNIT")) S ARR("UNIT")=""
M ^TMP(TMPLOC,$J)=ARR
K ARR
Q
AVUEN(ARR,DOC) ;
N CBK,CNT
S OPTION="",VBECRES=$NA(^TMP("VBECA1B",$J))
K @VBECRES
S (VBECLN,VBECTRHC,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC,VBECUNC,VBECUNS,VBECUNA,VBECUND)=0
D AVUSET(.CBK)
D EN^MXMLPRSE(DOC,.CBK,.OPTION)
M ARR=@VBECRES@("UNIT",$J)
K VBECABHC,VBECLN,VBECMSBC,VBECPRMS,VBECRES,VBECSRC,VBECSTAT
K VBECTRHC,VBECTSTC,VBECUNA,VBECUNC,VBECUND,VBECUNS,VBECY
K ^TMP("VBECAPI",$J),^TMP("VBECAPI1",$J),ARR1
Q
AVUSET(CBK) ;
K CBK
S CBK("STARTELEMENT")="AVUSTELE^VBECA1B1"
S CBK("ENDELEMENT")="ENELE^VBECA1B1"
S CBK("CHARACTERS")="CHAR^VBECA1B1"
Q
;
; ----------------------------------------------------------
; Private Method supports IA 4621
; ----------------------------------------------------------
TRAN(DFN) ; Returns VBECS Patient Transfusion History
K ^TMP("VBECAPI",$J),^TMP("VBECAPI1",$J)
D INITV^VBECRPCC("VBECS Patient Transfusion History")
S VBECY="^TMP(""VBECAPI"",$J)",VBECPRMS("RESULTS")="^TMP(""VBECAPI1"",$J)"
IF +VBECPRMS("ERROR") S ARR("ERROR")=VBECPRMS("ERROR") Q
SET VBECPRMS("PARAMS",1,"TYPE")="STRING"
SET VBECPRMS("PARAMS",1,"VALUE")=$$CHARCHK^XOBVLIB(DFN)
S VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
D PARSE^VBECRPC1(.VBECPRMS,VBECY)
D TRANEN(.ARR,VBECY)
Q
;
TRANEN(ARR,DOC) ;
N CBK,CNT
S OPTION="",VBECRES=$NA(^TMP("VBECA1B",$J))
K @VBECRES
S (VBECLN,VBECTRHC,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC,VBECUNC,VBECUNS,VBECUNA,VBECUND)=0
D TRANSET(.CBK)
D EN^MXMLPRSE(DOC,.CBK,.OPTION)
I '$D(@VBECRES@("TRAN")) S ARR="" Q
M ARR=@VBECRES@("TRAN")
K VBECABHC,VBECLN,VBECMSBC,VBECPRMS,VBECRES,VBECSRC,VBECSTAT
K VBECTRHC,VBECTSTC,VBECUNA,VBECUNC,VBECUND,VBECUNS,VBECY
K ^TMP("VBECAPI",$J),^TMP("VBECAPI1",$J),^TMP("VBECA1B",$J)
Q
;
TRANSET(CBK) ;
K CBK
S CBK("STARTELEMENT")="TRANSTEL^VBECA1B1"
S CBK("ENDELEMENT")="ENELE^VBECA1B1"
S CBK("CHARACTERS")="CHAR^VBECA1B1"
Q
;
; ----------------------------------------------------------
; Private Method supports IA 4623
; ----------------------------------------------------------
DFN(DFN) ; Returns VBECS Patient Reports for CPRS
D INITV^VBECRPCC("VBECS Patient Report")
S VBECY="^TMP(""VBECAPI"",$J)",VBECPRMS("RESULTS")="^TMP(""VBECAPI1"",$J)"
K @VBECY,@VBECPRMS("RESULTS")
IF +VBECPRMS("ERROR") S ARR("ERROR")=VBECPRMS("ERROR") Q
SET VBECPRMS("PARAMS",1,"TYPE")="STRING"
SET VBECPRMS("PARAMS",1,"VALUE")=$$CHARCHK^XOBVLIB(DFN)
S VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
D PARSE^VBECRPC1(.VBECPRMS,VBECY)
D RPTEN(.ARR,VBECY)
;K @VBECY,@VBECPRMS("RESULTS")
K VBECABHC,VBECLN,VBECMSBC,VBECPRMS,VBECRES,VBECSRC,VBECSTAT
K VBECTRHC,VBECTSTC,VBECUNA,VBECUNC,VBECUND,VBECUNS,VBECY
Q
RPTEN(ARR,DOC) ;
N CBK,CNT
S OPTION="",VBECRES=$NA(^TMP("VBDATA",$J))
K @VBECRES
S (VBECLN,VBECTRHC,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC,VBECUNC,VBECUNS,VBECUNA,VBECUND,VBECSTC,VBECCRC)=0
D RPTSET(.CBK)
D EN^MXMLPRSE(DOC,.CBK,.OPTION)
M ARR=@VBECRES
Q
RPTSET(CBK) ;
K CBK
S CBK("STARTELEMENT")="RPTSTELE^VBECA1B1"
S CBK("ENDELEMENT")="ENELE^VBECA1B1"
S CBK("CHARACTERS")="CHAR^VBECA1B1"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECA1B 8842 printed Sep 02, 2024@19:28:45 Page 2
VBECA1B ;HIOFO/BNT - VBECS Patient Data APIs ; 01/21/05 8:30am
+1 ;;2.0;VBEC;;Jun 05, 2015;Build 4
+2 ; Note: This routine supports data exchange with an FDA registered
+3 ; medical device. As such, it may not be changed in any way without
+4 ; prior written approval from the medical device manufacturer.
+5 ;
+6 ; Integration Agreements:
+7 ; Reference to ^DIC supported by IA #10006
+8 ; Reference to file 200 supported by IA #10035
+9 ; Reference to $$CHARCHK^XOBVLIB supported by IA #4090
+10 ; Reference to EN^MXMLPRSE supported by IA #4149
+11 ; Reference to ^DPT( supported by IA #10035
+12 ;
+13 QUIT
+14 ;
+15 ; ----------------------------------------------------------
+16 ; Private Method supports IA 4624
+17 ; ----------------------------------------------------------
ABORH(DFN,VBECTYP) ; Returns VBECS Patient ABO Group and Rh Type
+1 ; Input: DFN = PATIENT file (#2) IEN
+2 ; VBECTYP = "ABORH" or "ABO" or "RH" as needed.
+3 IF '$DATA(^DPT(DFN,0))
SET ARR("ERROR")="1^Invalid or Missing Patient Identifier"
QUIT ARR("ERROR")
+4 IF VBECTYP'="ABORH"&(VBECTYP'="ABO")&(VBECTYP'="RH")
SET ARR("ERROR")="1^Invalid Input"
QUIT ARR("ERROR")
+5 KILL ^TMP("VBECAPI",$JOB),^TMP("VBECAPI1",$JOB),ARR1
+6 DO INITV^VBECRPCC("VBECS Patient ABO_RH")
+7 SET VBECY="^TMP(""VBECAPI"",$J)"
SET VBECPRMS("RESULTS")="^TMP(""VBECAPI1"",$J)"
+8 IF +VBECPRMS("ERROR")
SET ARR("ERROR")=VBECPRMS("ERROR")
QUIT ARR("ERROR")
+9 SET VBECPRMS("PARAMS",1,"TYPE")="STRING"
+10 SET VBECPRMS("PARAMS",1,"VALUE")=$$CHARCHK^XOBVLIB(DFN)
+11 SET VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
+12 DO PARSE^VBECRPC1(.VBECPRMS,VBECY)
+13 IF $DATA(@VBECY@("ERROR"))
SET ARR("ERROR")="1^"_@VBECY@("ERROR")
QUIT ARR("ERROR")
+14 DO ABOEN(.ARR,VBECY)
+15 KILL ^TMP("VBECAPI",$JOB),^TMP("VBECAPI1",$JOB),ARR1
+16 ;K OPTION,VBECABHC,VBECLN,VBECMSBC,VBECPRMS,VBECRES
+17 KILL VBECSRC,VBECSTAT,VBECTRHC,VBECTSTC,VBECUNA,VBECUNC,VBECUND
+18 KILL VBECUNS,VBECY
+19 QUIT $GET(@VBECTYP)
ABOEN(ARR,DOC) ;
+1 NEW CBK,CNT
+2 SET OPTION=""
SET VBECRES=$NAME(ARR1("API"))
+3 KILL @VBECRES
+4 SET (VBECLN,VBECTRHC,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC,VBECUNC,VBECUNS,VBECUNA,VBECUND)=0
+5 DO ABOSET(.CBK)
+6 DO EN^MXMLPRSE(DOC,.CBK,.OPTION)
+7 QUIT
ABOSET(CBK) ;
+1 KILL CBK
+2 SET CBK("STARTELEMENT")="ABOSTELE^VBECA1B1"
+3 SET CBK("ENDELEMENT")="ENELE^VBECA1B1"
+4 SET CBK("CHARACTERS")="CHAR^VBECA1B1"
+5 QUIT
+6 ;
+7 ; ----------------------------------------------------------
+8 ; Private Method supports IA 4626
+9 ; ----------------------------------------------------------
TRRX(DFN) ; Returns VBECS Patient Transfusion Reaction History
+1 KILL ^TMP("VBECAPI",$JOB),^TMP("VBECAPI1",$JOB)
+2 DO INITV^VBECRPCC("VBECS Patient TRRX")
+3 SET VBECY="^TMP(""VBECAPI"",$J)"
SET VBECPRMS("RESULTS")="^TMP(""VBECAPI1"",$J)"
+4 IF +VBECPRMS("ERROR")
SET ARR("ERROR")=VBECPRMS("ERROR")
QUIT
+5 SET VBECPRMS("PARAMS",1,"TYPE")="STRING"
+6 SET VBECPRMS("PARAMS",1,"VALUE")=$$CHARCHK^XOBVLIB(DFN)
+7 SET VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
+8 DO PARSE^VBECRPC1(.VBECPRMS,VBECY)
+9 DO TRRXEN(.ARR,VBECY)
+10 IF '$DATA(ARR("TRRX"))
SET ARR("TRRX")=""
+11 QUIT
+12 ;
TRRXEN(ARR,DOC) ;
+1 NEW CBK,CNT
+2 SET OPTION=""
SET VBECRES=$NAME(^TMP("VBECA1B",$JOB))
+3 KILL @VBECRES
+4 SET (VBECLN,VBECTRHC,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC,VBECUNC,VBECUNS,VBECUNA,VBECUND)=0
+5 DO TRRXSET(.CBK)
+6 DO EN^MXMLPRSE(DOC,.CBK,.OPTION)
+7 MERGE ARR("TRRX")=@VBECRES
+8 KILL VBECABHC,VBECLN,VBECMSBC,VBECPRMS,VBECRES,VBECSRC,VBECSTAT
+9 KILL VBECTRHC,VBECTSTC,VBECUNA,VBECUNC,VBECUND,VBECUNS,VBECY
+10 KILL ^TMP("VBECAPI",$JOB),^TMP("VBECAPI1",$JOB)
+11 QUIT
+12 ;
TRRXSET(CBK) ;
+1 KILL CBK
+2 SET CBK("STARTELEMENT")="TRSTELE^VBECA1B1"
+3 SET CBK("ENDELEMENT")="ENELE^VBECA1B1"
+4 SET CBK("CHARACTERS")="CHAR^VBECA1B1"
+5 QUIT
+6 ;
+7 ; ----------------------------------------------------------
+8 ; Private Method supports IA 4625
+9 ; ----------------------------------------------------------
ABID(DFN) ; Returns VBECS Patient Antibodies Identified
+1 DO INITV^VBECRPCC("VBECS Patient ABID")
+2 SET VBECY="^TMP(""VBECAPI"",$J)"
SET VBECPRMS("RESULTS")="^TMP(""VBECAPI1"",$J)"
+3 KILL @VBECY,@VBECPRMS("RESULTS")
+4 IF +VBECPRMS("ERROR")
SET ARR("ERROR")=VBECPRMS("ERROR")
QUIT
+5 SET VBECPRMS("PARAMS",1,"TYPE")="STRING"
+6 SET VBECPRMS("PARAMS",1,"VALUE")=$$CHARCHK^XOBVLIB(DFN)
+7 SET VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
+8 DO PARSE^VBECRPC1(.VBECPRMS,VBECY)
+9 DO ABIDEN(.ARR,VBECY)
+10 ;K @VBECY,@VBECPRMS("RESULTS")
+11 KILL ARR1,ATR,ATR,CBK,CNT,DFN,DOC,ELE,OPTION,TEXT,VBECABHC,VBECLN
+12 KILL VBECMSBC,VBECPRMS,VBECRES,VBECSRC,VBECSTAT,VBECTRHC,VBECTSTC
+13 KILL VBECUNA,VBECUNC,VBECUND,VBECUNS,VBECY
+14 QUIT
+15 ;
ABIDEN(ARR,DOC) ;
+1 NEW CBK,CNT
+2 SET OPTION=""
SET VBECRES=$NAME(^TMP("VBECA1B",$JOB))
+3 KILL @VBECRES
+4 SET (VBECLN,VBECTRHC,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC,VBECUNC,VBECUNS,VBECUNA,VBECUND)=0
+5 DO ABSET(.CBK)
+6 DO EN^MXMLPRSE(DOC,.CBK,.OPTION)
+7 MERGE ARR("ABID")=@VBECRES
+8 QUIT
+9 ;
ABSET(CBK) ;
+1 KILL CBK
+2 SET CBK("STARTELEMENT")="ABSTELE^VBECA1B1"
+3 SET CBK("ENDELEMENT")="ENELE^VBECA1B1"
+4 SET CBK("CHARACTERS")="CHAR^VBECA1B1"
+5 QUIT
+6 ;
+7 ; ----------------------------------------------------------
+8 ; Private Method supports IA 4620
+9 ; ----------------------------------------------------------
AVUNIT(TMPLOC,DFN) ; Returns VBECS Patient Available Units
+1 ; Input variable;
+2 ; TMPLOC = Node in ^TMP to be used for output data array
+3 ; DFN = Internal number of patient
+4 ;
+5 ; Output is data array:
+6 ; ^TMP(TMPLOC,$J,n)
+7 ;
+8 if $GET(TMPLOC)=""
QUIT
+9 if '$GET(DFN)
QUIT
+10 KILL ^TMP("VBECAPI",$JOB),^TMP("VBECAPI1",$JOB),^TMP(TMPLOC,$JOB)
+11 DO INITV^VBECRPCC("VBECS Patient Available Units")
+12 SET VBECY="^TMP(""VBECAPI"",$J)"
SET VBECPRMS("RESULTS")="^TMP(""VBECAPI1"",$J)"
+13 IF +VBECPRMS("ERROR")
SET ARR("ERROR")=VBECPRMS("ERROR")
QUIT
+14 SET VBECPRMS("PARAMS",1,"TYPE")="STRING"
+15 SET VBECPRMS("PARAMS",1,"VALUE")=$$CHARCHK^XOBVLIB(DFN)
+16 SET VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
+17 DO PARSE^VBECRPC1(.VBECPRMS,VBECY)
+18 DO AVUEN(.ARR,VBECY)
+19 IF '$DATA(ARR("UNIT"))
SET ARR("UNIT")=""
+20 MERGE ^TMP(TMPLOC,$JOB)=ARR
+21 KILL ARR
+22 QUIT
AVUEN(ARR,DOC) ;
+1 NEW CBK,CNT
+2 SET OPTION=""
SET VBECRES=$NAME(^TMP("VBECA1B",$JOB))
+3 KILL @VBECRES
+4 SET (VBECLN,VBECTRHC,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC,VBECUNC,VBECUNS,VBECUNA,VBECUND)=0
+5 DO AVUSET(.CBK)
+6 DO EN^MXMLPRSE(DOC,.CBK,.OPTION)
+7 MERGE ARR=@VBECRES@("UNIT",$JOB)
+8 KILL VBECABHC,VBECLN,VBECMSBC,VBECPRMS,VBECRES,VBECSRC,VBECSTAT
+9 KILL VBECTRHC,VBECTSTC,VBECUNA,VBECUNC,VBECUND,VBECUNS,VBECY
+10 KILL ^TMP("VBECAPI",$JOB),^TMP("VBECAPI1",$JOB),ARR1
+11 QUIT
AVUSET(CBK) ;
+1 KILL CBK
+2 SET CBK("STARTELEMENT")="AVUSTELE^VBECA1B1"
+3 SET CBK("ENDELEMENT")="ENELE^VBECA1B1"
+4 SET CBK("CHARACTERS")="CHAR^VBECA1B1"
+5 QUIT
+6 ;
+7 ; ----------------------------------------------------------
+8 ; Private Method supports IA 4621
+9 ; ----------------------------------------------------------
TRAN(DFN) ; Returns VBECS Patient Transfusion History
+1 KILL ^TMP("VBECAPI",$JOB),^TMP("VBECAPI1",$JOB)
+2 DO INITV^VBECRPCC("VBECS Patient Transfusion History")
+3 SET VBECY="^TMP(""VBECAPI"",$J)"
SET VBECPRMS("RESULTS")="^TMP(""VBECAPI1"",$J)"
+4 IF +VBECPRMS("ERROR")
SET ARR("ERROR")=VBECPRMS("ERROR")
QUIT
+5 SET VBECPRMS("PARAMS",1,"TYPE")="STRING"
+6 SET VBECPRMS("PARAMS",1,"VALUE")=$$CHARCHK^XOBVLIB(DFN)
+7 SET VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
+8 DO PARSE^VBECRPC1(.VBECPRMS,VBECY)
+9 DO TRANEN(.ARR,VBECY)
+10 QUIT
+11 ;
TRANEN(ARR,DOC) ;
+1 NEW CBK,CNT
+2 SET OPTION=""
SET VBECRES=$NAME(^TMP("VBECA1B",$JOB))
+3 KILL @VBECRES
+4 SET (VBECLN,VBECTRHC,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC,VBECUNC,VBECUNS,VBECUNA,VBECUND)=0
+5 DO TRANSET(.CBK)
+6 DO EN^MXMLPRSE(DOC,.CBK,.OPTION)
+7 IF '$DATA(@VBECRES@("TRAN"))
SET ARR=""
QUIT
+8 MERGE ARR=@VBECRES@("TRAN")
+9 KILL VBECABHC,VBECLN,VBECMSBC,VBECPRMS,VBECRES,VBECSRC,VBECSTAT
+10 KILL VBECTRHC,VBECTSTC,VBECUNA,VBECUNC,VBECUND,VBECUNS,VBECY
+11 KILL ^TMP("VBECAPI",$JOB),^TMP("VBECAPI1",$JOB),^TMP("VBECA1B",$JOB)
+12 QUIT
+13 ;
TRANSET(CBK) ;
+1 KILL CBK
+2 SET CBK("STARTELEMENT")="TRANSTEL^VBECA1B1"
+3 SET CBK("ENDELEMENT")="ENELE^VBECA1B1"
+4 SET CBK("CHARACTERS")="CHAR^VBECA1B1"
+5 QUIT
+6 ;
+7 ; ----------------------------------------------------------
+8 ; Private Method supports IA 4623
+9 ; ----------------------------------------------------------
DFN(DFN) ; Returns VBECS Patient Reports for CPRS
+1 DO INITV^VBECRPCC("VBECS Patient Report")
+2 SET VBECY="^TMP(""VBECAPI"",$J)"
SET VBECPRMS("RESULTS")="^TMP(""VBECAPI1"",$J)"
+3 KILL @VBECY,@VBECPRMS("RESULTS")
+4 IF +VBECPRMS("ERROR")
SET ARR("ERROR")=VBECPRMS("ERROR")
QUIT
+5 SET VBECPRMS("PARAMS",1,"TYPE")="STRING"
+6 SET VBECPRMS("PARAMS",1,"VALUE")=$$CHARCHK^XOBVLIB(DFN)
+7 SET VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
+8 DO PARSE^VBECRPC1(.VBECPRMS,VBECY)
+9 DO RPTEN(.ARR,VBECY)
+10 ;K @VBECY,@VBECPRMS("RESULTS")
+11 KILL VBECABHC,VBECLN,VBECMSBC,VBECPRMS,VBECRES,VBECSRC,VBECSTAT
+12 KILL VBECTRHC,VBECTSTC,VBECUNA,VBECUNC,VBECUND,VBECUNS,VBECY
+13 QUIT
RPTEN(ARR,DOC) ;
+1 NEW CBK,CNT
+2 SET OPTION=""
SET VBECRES=$NAME(^TMP("VBDATA",$JOB))
+3 KILL @VBECRES
+4 SET (VBECLN,VBECTRHC,VBECABHC,VBECTSTC,VBECMSBC,VBECSRC,VBECUNC,VBECUNS,VBECUNA,VBECUND,VBECSTC,VBECCRC)=0
+5 DO RPTSET(.CBK)
+6 DO EN^MXMLPRSE(DOC,.CBK,.OPTION)
+7 MERGE ARR=@VBECRES
+8 QUIT
RPTSET(CBK) ;
+1 KILL CBK
+2 SET CBK("STARTELEMENT")="RPTSTELE^VBECA1B1"
+3 SET CBK("ENDELEMENT")="ENELE^VBECA1B1"
+4 SET CBK("CHARACTERS")="CHAR^VBECA1B1"
+5 QUIT
