VBECA1B1 ;HIOFO/BNT - VBECS Patient Data API continued ;04/12/2005 03:10
;;2.0;VBECS;**8**;Jun 05, 2015;Build 27
;
; 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:
; Call to $$STRIP^XLFSTR is supported by IA: 10104
; Call to $$FMTE^XLFDT is supported by IA: 10103
; Call to $$NS^XUAF4 is supported by IA: 2171
; Call to $$STA^XUAF4 is supported by IA: 2171
; Call to F4^XUAF4 is supported by IA: 2171
;
ENELE(ELE) ; -- element end event handler
Q
;
CHAR(TEXT) ; -- element char event handler
Q
;
ABOSTELE(ELE,ATR) ; -- element start event handler for Patient ABO/Rh API
I ELE="Patient" S ABO=$G(ATR("abo")),RH=$G(ATR("rh")),ABORH=$G(ATR("abo"))_" "_$G(ATR("rh"))
Q
;
TRSTELE(ELE,ATR) ; -- element start event handler for Patient Transfusion Reaction History API
I ELE="TransfusionReaction" D
. S VBECLN=VBECLN+1,@VBECRES@(VBECLN)=$G(ATR("date"))_"^"_$G(ATR("type"))
. D:$L($G(ATR("comment"))) BLDCMT(ATR("comment"))
. I $G(ATR("unitId"))]"" S @VBECRES@(VBECLN)=@VBECRES@(VBECLN)_"^"_$G(ATR("unitId"))_"^"_$G(ATR("productTypeName"))_"^"_$G(ATR("productTypePrintName"))
Q
;
BLDCMT(STR) ; Build comment text paragraph for Antibodies Identified
N CNT
P1 I $L(STR)<80 S CNT=$G(CNT)+1,@VBECRES@(VBECLN,CNT)=STR Q
F L=80:-1:1 Q:$E(STR,L)=" "
S CNT=$G(CNT)+1,@VBECRES@(VBECLN,CNT)=$E(STR,1,L-1),STR=$E(STR,L+1,99999) G P1
Q
BLDCMTTR(STR) ; Build comment text paragraph for Transfusion Requirements RLM 011620
N CNT
P1T I $L(STR)<80 S CNT=$G(CNT)+1,@VBECRES@("TR",VBECLNTR,CNT)=STR Q
F L=80:-1:1 Q:$E(STR,L)=" "
S CNT=$G(CNT)+1,@VBECRES@("TR",VBECLNTR,CNT)=$E(STR,1,L-1),STR=$E(STR,L+1,99999) G P1T
;
ABSTELE(ELE,ATR) ; -- element start event handler Patient Antibodies Identified API
I ELE="Antibody" D
. S VBECLN=VBECLN+1,@VBECRES@(VBECLN)=$G(ATR("name"))
. D:$L($G(ATR("comment"))) BLDCMT(ATR("comment"))
I ELE="TransfusionRequirement" D ;RLM 011620
. S VBECLNTR=$G(VBECLNTR)+1,@VBECRES@("TR",VBECLNTR)=$G(ATR("name"))
. D:$L($G(ATR("comment"))) BLDCMTTR(ATR("comment"))
Q
;
AVUSTELE(ELE,ATR) ; -- element start event handler Patient Available Units API
I ELE="Patient" S @VBECRES@("UNIT",$J,0)=$$STRIP^XLFSTR($G(ATR("abo"))," ")_"^"_$S($G(ATR("rh"))="P":"POS",$G(ATR("rh"))="N":"NEG",1:"")_U_$G(ATR("dfn"))_U_$G(ATR("firstName"))_U_$G(ATR("lastName"))_U_$G(ATR("dob"))_U_$G(ATR("ssn"))
;
I ELE="Unit" D
. S IDT=9999999-$G(ATR("dateAssigned")),EDT=$G(ATR("expDate"))
. S EFLG=$S(EDT-DT<2:"*",EDT-DT<1:"**",1:"")
. S EDT=$TR($$FMTE^XLFDT(EDT,"5DZ"),"@"," ")
. S DTYP=$S($G(ATR("status"))="A":"Autologous",$G(ATR("status"))="D":"Directed",1:"")
. ; Added $$STRIP to support 035 VistA MR 030407
. I $G(ATR("divisionCode")) D F4^XUAF4($$STRIP^XLFSTR(ATR("divisionCode")," "),.DIVARR,"","")
. S UDIV=$S($G(DIVARR("NAME"))]"":$G(DIVARR("NAME")),1:"Unknown")
. F Q:'$D(@VBECRES@("UNIT",$J,IDT)) S IDT=IDT+.000001 ;RLM use 6 decimals instead of 4
. S @VBECRES@("UNIT",$J,IDT)=EFLG_U_EDT_" "_U_$$TRIM^XLFSTR($G(ATR("id")),"LR"," ")_U_$G(ATR("product"))_U_$G(ATR("volume"))_U_$G(ATR("abo"))_U_$G(ATR("rh"))_U_DTYP_U_UDIV_U
. S @VBECRES@("UNIT",$J,IDT)=@VBECRES@("UNIT",$J,IDT)_$S($G(ATR("location"))]"":ATR("location"),1:"BLOOD BANK")_U_$G(ATR("productCode"))_U_$G(ATR("labelid"))_U_$G(ATR("productName"))_U_$G(ATR("issueDate"))
. ;RLM Added the labelid
Q
;
TRANSTEL(ELE,ATR) ; -- element start event handler for Transfusion History API
I ELE="Transfusion" D
. N IDT,TDT,UNITS,VAL
. S VBECLN=VBECLN+1
. S IDT=9999999-$P($G(ATR("date")),".")
. S TDT=9999999-IDT
. S UNITS=+$G(ATR("unitsPooled")) S:UNITS'>0 UNITS=1
. ; 038 VistA MR 031407 - Increment date counter for multiple records
. F Q:'$D(@VBECRES@("TRAN",IDT)) S IDT=IDT+.000001 ;RLM 6 decimal instead of 4
. S @VBECRES@("TRAN",IDT)=TDT_"^"_UNITS_"\"_$G(ATR("productTypePrintName"))_";"_"^"_$G(ATR("abo"))_"^"_$G(ATR("rh"))_"^"_$G(ATR("productCode"))_"^"_$G(ATR("unitid"))_"^"_$G(ATR("productName"))
. S @VBECRES@("TRAN",$G(ATR("productTypePrintName")))=$G(ATR("productTypeName"))
Q
;
RPTSTELE(ELE,ATR) ; -- element start event handler
I ELE="SpecimenTest" D
. S VBECSTC=VBECSTC+1 D
. . ;I ATR("printTestName")="DAT Poly CC" Q ;Removed per defect 434646
. . ;I ATR("printTestName")="DAT IgG CC" Q ;Removed per defect 434646
. . ;I $G(ATR("orderableTestName"))="TRW" Q ;Removed per defect 434646
. . S @VBECRES@("SPECIMEN",VBECSTC)=$G(ATR("cprsOrderId"))_"^"_$G(ATR("divisionCode"))_"^"_$G(ATR("enteringTechId"))_"^"_$G(ATR("orderableTestName"))_"^"_$G(ATR("printTestName"))_"^"_$G(ATR("requestorId"))
. . S @VBECRES@("SPECIMEN",VBECSTC)=@VBECRES@("SPECIMEN",VBECSTC)_"^"_$G(ATR("result"))_"^"_$G(ATR("testDate"))_"^"_$G(ATR("specimenuid"))_"^"_$G(ATR("specimencollectiondate"))
. . I $G(ATR("comment"))]"" D
. . . S @VBECRES@("SPECIMEN",VBECSTC,1)=$E($G(ATR("comment")),1,245)
. . . S @VBECRES@("SPECIMEN",VBECSTC,2)=$E($G(ATR("comment")),246,490)
. . . S @VBECRES@("SPECIMEN",VBECSTC,3)=$E($G(ATR("comment")),491,999)
. . I $G(ATR("cannedComment"))]"" I $G(ATR("result"))="Pos" D
. . . S VBECSTN("Antibody Screen Interp")="",VBECSTN("DAT Poly Interp")="",VBECSTN("DAT IgG Interp")="",VBECSTN("DAT Comp Interp")=""
. . . I $G(ATR("printTestName"))]"",'$D(VBECSTN(ATR("printTestName"))) Q
. . . S @VBECRES@("SPECIMEN",VBECSTC,4)=$E($G(ATR("cannedComment")),1,245)
. . . S @VBECRES@("SPECIMEN",VBECSTC,5)=$E($G(ATR("cannedComment")),246,490)
. . . S @VBECRES@("SPECIMEN",VBECSTC,6)=$E($G(ATR("cannedComment")),491,999)
. . D ;I $G(ATR("result"))="Neg" D
. . . S VBECSTN("Antibody Screen Interp")="",VBECSTN("DAT Poly Interp")="",VBECSTN("DAT IgG Interp")="",VBECSTN("DAT Comp Interp")=""
. . . I $G(ATR("printTestName"))]"",'$D(VBECSTN(ATR("printTestName"))) Q
. . . S @VBECRES@("SPECIMEN",VBECSTC,7)="Reference range for antibody screen and DAT is Neg"
I ELE="ComponentRequest" D
. S VBECCRC=VBECCRC+1 D
. . S @VBECRES@("COMPONENT REQUEST",VBECCRC)=$G(ATR("componentClassName"))_"^"_ATR("unitsRequested")_"^"_$G(ATR("dateRequested"))_"^"_$G(ATR("dateWanted"))_"^"_$G(ATR("requestorId"))_"^"_$G(ATR("enteredById"))_"^"_$G(ATR("cprsOrderId"))
I ELE="Unit" D
. S VBECUNC=VBECUNC+1 D
. . ; fixed VBECUNC variable to address 034 VistA MR 030407
. . S @VBECRES@("UNIT",VBECUNC)=$G(ATR("expDate"))_"^"_$G(ATR("product"))_"^"_$G(ATR("abo"))_"^"_$G(ATR("rh"))_"^"_$G(ATR("divisionCode"))_"^"_$G(ATR("location"))_"^"_$G(ATR("status"))_"^"_$G(ATR("id"))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECA1B1 6709 printed Sep 23, 2025@20:19:50 Page 2
VBECA1B1 ;HIOFO/BNT - VBECS Patient Data API continued ;04/12/2005 03:10
+1 ;;2.0;VBECS;**8**;Jun 05, 2015;Build 27
+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 ; Call to $$STRIP^XLFSTR is supported by IA: 10104
+9 ; Call to $$FMTE^XLFDT is supported by IA: 10103
+10 ; Call to $$NS^XUAF4 is supported by IA: 2171
+11 ; Call to $$STA^XUAF4 is supported by IA: 2171
+12 ; Call to F4^XUAF4 is supported by IA: 2171
+13 ;
ENELE(ELE) ; -- element end event handler
+1 QUIT
+2 ;
CHAR(TEXT) ; -- element char event handler
+1 QUIT
+2 ;
ABOSTELE(ELE,ATR) ; -- element start event handler for Patient ABO/Rh API
+1 IF ELE="Patient"
SET ABO=$GET(ATR("abo"))
SET RH=$GET(ATR("rh"))
SET ABORH=$GET(ATR("abo"))_" "_$GET(ATR("rh"))
+2 QUIT
+3 ;
TRSTELE(ELE,ATR) ; -- element start event handler for Patient Transfusion Reaction History API
+1 IF ELE="TransfusionReaction"
Begin DoDot:1
+2 SET VBECLN=VBECLN+1
SET @VBECRES@(VBECLN)=$GET(ATR("date"))_"^"_$GET(ATR("type"))
+3 if $LENGTH($GET(ATR("comment")))
DO BLDCMT(ATR("comment"))
+4 IF $GET(ATR("unitId"))]""
SET @VBECRES@(VBECLN)=@VBECRES@(VBECLN)_"^"_$GET(ATR("unitId"))_"^"_$GET(ATR("productTypeName"))_"^"_$GET(ATR("productTypePrintName"))
End DoDot:1
+5 QUIT
+6 ;
BLDCMT(STR) ; Build comment text paragraph for Antibodies Identified
+1 NEW CNT
P1 IF $LENGTH(STR)<80
SET CNT=$GET(CNT)+1
SET @VBECRES@(VBECLN,CNT)=STR
QUIT
+1 FOR L=80:-1:1
if $EXTRACT(STR,L)=" "
QUIT
+2 SET CNT=$GET(CNT)+1
SET @VBECRES@(VBECLN,CNT)=$EXTRACT(STR,1,L-1)
SET STR=$EXTRACT(STR,L+1,99999)
GOTO P1
+3 QUIT
BLDCMTTR(STR) ; Build comment text paragraph for Transfusion Requirements RLM 011620
+1 NEW CNT
P1T IF $LENGTH(STR)<80
SET CNT=$GET(CNT)+1
SET @VBECRES@("TR",VBECLNTR,CNT)=STR
QUIT
+1 FOR L=80:-1:1
if $EXTRACT(STR,L)=" "
QUIT
+2 SET CNT=$GET(CNT)+1
SET @VBECRES@("TR",VBECLNTR,CNT)=$EXTRACT(STR,1,L-1)
SET STR=$EXTRACT(STR,L+1,99999)
GOTO P1T
+3 ;
ABSTELE(ELE,ATR) ; -- element start event handler Patient Antibodies Identified API
+1 IF ELE="Antibody"
Begin DoDot:1
+2 SET VBECLN=VBECLN+1
SET @VBECRES@(VBECLN)=$GET(ATR("name"))
+3 if $LENGTH($GET(ATR("comment")))
DO BLDCMT(ATR("comment"))
End DoDot:1
+4 ;RLM 011620
IF ELE="TransfusionRequirement"
Begin DoDot:1
+5 SET VBECLNTR=$GET(VBECLNTR)+1
SET @VBECRES@("TR",VBECLNTR)=$GET(ATR("name"))
+6 if $LENGTH($GET(ATR("comment")))
DO BLDCMTTR(ATR("comment"))
End DoDot:1
+7 QUIT
+8 ;
AVUSTELE(ELE,ATR) ; -- element start event handler Patient Available Units API
+1 IF ELE="Patient"
SET @VBECRES@("UNIT",$JOB,0)=$$STRIP^XLFSTR($GET(ATR("abo"))," ")_"^"_$SELECT($GET(ATR("rh"))="P":"POS",$GET(ATR("rh"))="N":"NEG",1:"")_U_$GET(ATR("dfn"))_U_$GET(ATR("firstName"))_U_$GET(ATR("lastName"))_U_$GET(ATR("dob"))_U_$GET(ATR("ssn")
)
+2 ;
+3 IF ELE="Unit"
Begin DoDot:1
+4 SET IDT=9999999-$GET(ATR("dateAssigned"))
SET EDT=$GET(ATR("expDate"))
+5 SET EFLG=$SELECT(EDT-DT<2:"*",EDT-DT<1:"**",1:"")
+6 SET EDT=$TRANSLATE($$FMTE^XLFDT(EDT,"5DZ"),"@"," ")
+7 SET DTYP=$SELECT($GET(ATR("status"))="A":"Autologous",$GET(ATR("status"))="D":"Directed",1:"")
+8 ; Added $$STRIP to support 035 VistA MR 030407
+9 IF $GET(ATR("divisionCode"))
DO F4^XUAF4($$STRIP^XLFSTR(ATR("divisionCode")," "),.DIVARR,"","")
+10 SET UDIV=$SELECT($GET(DIVARR("NAME"))]"":$GET(DIVARR("NAME")),1:"Unknown")
+11 ;RLM use 6 decimals instead of 4
FOR
if '$DATA(@VBECRES@("UNIT",$JOB,IDT))
QUIT
SET IDT=IDT+.000001
+12 SET @VBECRES@("UNIT",$JOB,IDT)=EFLG_U_EDT_" "_U_$$TRIM^XLFSTR($GET(ATR("id")),"LR"," ")_U_$GET(ATR("product"))_U_$GET(ATR("volume"))_U_$GET(ATR("abo"))_U_$GET(ATR("rh"))_U_DTYP_U_UDIV_U
+13 SET @VBECRES@("UNIT",$JOB,IDT)=@VBECRES@("UNIT",$JOB,IDT)_$SELECT($GET(ATR("location"))]"":ATR("location"),1:"BLOOD BANK")_U_$GET(ATR("productCode"))_U_$GET(ATR("labelid"))_U_$GET(ATR("productName"))_U_$GET(ATR("issueDate"))
+14 ;RLM Added the labelid
End DoDot:1
+15 QUIT
+16 ;
TRANSTEL(ELE,ATR) ; -- element start event handler for Transfusion History API
+1 IF ELE="Transfusion"
Begin DoDot:1
+2 NEW IDT,TDT,UNITS,VAL
+3 SET VBECLN=VBECLN+1
+4 SET IDT=9999999-$PIECE($GET(ATR("date")),".")
+5 SET TDT=9999999-IDT
+6 SET UNITS=+$GET(ATR("unitsPooled"))
if UNITS'>0
SET UNITS=1
+7 ; 038 VistA MR 031407 - Increment date counter for multiple records
+8 ;RLM 6 decimal instead of 4
FOR
if '$DATA(@VBECRES@("TRAN",IDT))
QUIT
SET IDT=IDT+.000001
+9 SET @VBECRES@("TRAN",IDT)=TDT_"^"_UNITS_"\"_$GET(ATR("productTypePrintName"))_";"_"^"_$GET(ATR("abo"))_"^"_$GET(ATR("rh"))_"^"_$GET(ATR("productCode"))_"^"_$GET(ATR("unitid"))_"^"_$GET(ATR("productName"))
+10 SET @VBECRES@("TRAN",$GET(ATR("productTypePrintName")))=$GET(ATR("productTypeName"))
End DoDot:1
+11 QUIT
+12 ;
RPTSTELE(ELE,ATR) ; -- element start event handler
+1 IF ELE="SpecimenTest"
Begin DoDot:1
+2 SET VBECSTC=VBECSTC+1
Begin DoDot:2
+3 ;I ATR("printTestName")="DAT Poly CC" Q ;Removed per defect 434646
+4 ;I ATR("printTestName")="DAT IgG CC" Q ;Removed per defect 434646
+5 ;I $G(ATR("orderableTestName"))="TRW" Q ;Removed per defect 434646
+6 SET @VBECRES@("SPECIMEN",VBECSTC)=$GET(ATR("cprsOrderId"))_"^"_$GET(ATR("divisionCode"))_"^"_$GET(ATR("enteringTechId"))_"^"_$GET(ATR("orderableTestName"))_"^"_$GET(ATR("printTestName"))_"^"_$GET(ATR("requestorId"))
+7 SET @VBECRES@("SPECIMEN",VBECSTC)=@VBECRES@("SPECIMEN",VBECSTC)_"^"_$GET(ATR("result"))_"^"_$GET(ATR("testDate"))_"^"_$GET(ATR("specimenuid"))_"^"_$GET(ATR("specimencollectiondate"))
+8 IF $GET(ATR("comment"))]""
Begin DoDot:3
+9 SET @VBECRES@("SPECIMEN",VBECSTC,1)=$EXTRACT($GET(ATR("comment")),1,245)
+10 SET @VBECRES@("SPECIMEN",VBECSTC,2)=$EXTRACT($GET(ATR("comment")),246,490)
+11 SET @VBECRES@("SPECIMEN",VBECSTC,3)=$EXTRACT($GET(ATR("comment")),491,999)
End DoDot:3
+12 IF $GET(ATR("cannedComment"))]""
IF $GET(ATR("result"))="Pos"
Begin DoDot:3
+13 SET VBECSTN("Antibody Screen Interp")=""
SET VBECSTN("DAT Poly Interp")=""
SET VBECSTN("DAT IgG Interp")=""
SET VBECSTN("DAT Comp Interp")=""
+14 IF $GET(ATR("printTestName"))]""
IF '$DATA(VBECSTN(ATR("printTestName")))
QUIT
+15 SET @VBECRES@("SPECIMEN",VBECSTC,4)=$EXTRACT($GET(ATR("cannedComment")),1,245)
+16 SET @VBECRES@("SPECIMEN",VBECSTC,5)=$EXTRACT($GET(ATR("cannedComment")),246,490)
+17 SET @VBECRES@("SPECIMEN",VBECSTC,6)=$EXTRACT($GET(ATR("cannedComment")),491,999)
End DoDot:3
+18 ;I $G(ATR("result"))="Neg" D
Begin DoDot:3
+19 SET VBECSTN("Antibody Screen Interp")=""
SET VBECSTN("DAT Poly Interp")=""
SET VBECSTN("DAT IgG Interp")=""
SET VBECSTN("DAT Comp Interp")=""
+20 IF $GET(ATR("printTestName"))]""
IF '$DATA(VBECSTN(ATR("printTestName")))
QUIT
+21 SET @VBECRES@("SPECIMEN",VBECSTC,7)="Reference range for antibody screen and DAT is Neg"
End DoDot:3
End DoDot:2
End DoDot:1
+22 IF ELE="ComponentRequest"
Begin DoDot:1
+23 SET VBECCRC=VBECCRC+1
Begin DoDot:2
+24 SET @VBECRES@("COMPONENT REQUEST",VBECCRC)=$GET(ATR("componentClassName"))_"^"_ATR("unitsRequested")_"^"_$GET(ATR("dateRequested"))_"^"_$GET(ATR("dateWanted"))_"^"_$GET(ATR("requestorId"))_"^"_$GET(ATR("enteredById"))_"^"_$GET(ATR("
cprsOrderId"))
End DoDot:2
End DoDot:1
+25 IF ELE="Unit"
Begin DoDot:1
+26 SET VBECUNC=VBECUNC+1
Begin DoDot:2
+27 ; fixed VBECUNC variable to address 034 VistA MR 030407
+28 SET @VBECRES@("UNIT",VBECUNC)=$GET(ATR("expDate"))_"^"_$GET(ATR("product"))_"^"_$GET(ATR("abo"))_"^"_$GET(ATR("rh"))_"^"_$GET(ATR("divisionCode"))_"^"_$GET(ATR("location"))_"^"_$GET(ATR("status"))_"^"_$GET(ATR("id"))
End DoDot:2
End DoDot:1
+29 QUIT
