Routine: VBECA1B

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)

ABOSET(CBK) ;

 K CBK

 S CBK("STARTELEMENT")="ABOSTELE^VBECA1B1"

 S CBK("ENDELEMENT")="ENELE^VBECA1B1"

 S CBK("CHARACTERS")="CHAR^VBECA1B1"

 ; ----------------------------------------------------------

 ;      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")=""

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)

TRRXSET(CBK) ;

 K CBK

 S CBK("STARTELEMENT")="TRSTELE^VBECA1B1"

 S CBK("ENDELEMENT")="ENELE^VBECA1B1"

 S CBK("CHARACTERS")="CHAR^VBECA1B1"

 ; ----------------------------------------------------------

 ;      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

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

ABSET(CBK) ;

 K CBK

 S CBK("STARTELEMENT")="ABSTELE^VBECA1B1"

 S CBK("ENDELEMENT")="ENELE^VBECA1B1"

 S CBK("CHARACTERS")="CHAR^VBECA1B1"

 ; ----------------------------------------------------------

 ;      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

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

AVUSET(CBK) ;

 K CBK

 S CBK("STARTELEMENT")="AVUSTELE^VBECA1B1"

 S CBK("ENDELEMENT")="ENELE^VBECA1B1"

 S CBK("CHARACTERS")="CHAR^VBECA1B1"

 ; ----------------------------------------------------------

 ;      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)

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)

TRANSET(CBK) ;

 K CBK

 S CBK("STARTELEMENT")="TRANSTEL^VBECA1B1"

 S CBK("ENDELEMENT")="ENELE^VBECA1B1"

 S CBK("CHARACTERS")="CHAR^VBECA1B1"

 ; ----------------------------------------------------------

 ;      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

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

RPTSET(CBK) ;

 K CBK

 S CBK("STARTELEMENT")="RPTSTELE^VBECA1B1"

 S CBK("ENDELEMENT")="ENELE^VBECA1B1"

 S CBK("CHARACTERS")="CHAR^VBECA1B1"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECA1B   8842     printed  Feb 19, 2025@00:10:13                                                                                                                                                                                                     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

VBECA1B.m