VBECDSS ;;HOIFO/BNT-VBECS DSS Extract ;December 05, 2006
;;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.
;
QUIT
;
EN(RESULT,PARAMS) ; Main Entry point for RPC
; -- RPC: VBECS DSS EXTRACT
; -- INPUT: PARAMS Array containing values to be inserted or updated
; -- in the VBECS DSS EXTRACT File (#6002.03).
;
N I,X,Y,VBECRSLT,VBECLINE,FDA,VBERR
I '$D(DT) D DT^DICRW
S VBECRSLT="^TMP(""VBEC_DSS_EXTRACT"",$J)",VBECLINE=0,RESULT=$NA(@VBECRSLT)
K @RESULT
I '$D(PARAMS("TRANSACTION ID")) D RESULT(0) Q
S VBECON=$$FIND1^DIC(6002.03,,,PARAMS("TRANSACTION ID"),,.ERROR)
S VBECIEN=$S(VBECON:VBECON_",",1:"+1,")
S FDA(1,6002.03,VBECIEN,.01)=PARAMS("TRANSACTION ID")
I $D(PARAMS("DFN")),PARAMS("DFN") S FDA(1,6002.03,VBECIEN,1)=$G(PARAMS("DFN"))
I $D(PARAMS("ORDERING LOCATION")) S FDA(1,6002.03,VBECIEN,2)=$G(PARAMS("ORDERING LOCATION"))
I $D(PARAMS("TRANSFUSION LOCATION")) S FDA(1,6002.03,VBECIEN,3)=$G(PARAMS("TRANSFUSION LOCATION"))
;I $D(PARAMS("FACILITY")) S VBFAC=$$TSTRIP($G(PARAMS("FACILITY"))),VBFAC=$$FIND1^DIC(4,,"MX",VBFAC,,,"VBERR") D
;. S FDA(1,6002.03,VBECIEN,3)=VBFAC
I $D(PARAMS("PHYSICIAN")) S FDA(1,6002.03,VBECIEN,4)=$G(PARAMS("PHYSICIAN"))
I $D(PARAMS("ORDERING PROVIDER")) S FDA(1,6002.03,VBECIEN,5)=$G(PARAMS("ORDERING PROVIDER"))
I $D(PARAMS("PRODUCT NAME")) S FDA(1,6002.03,VBECIEN,6)=$G(PARAMS("PRODUCT NAME"))
I $D(PARAMS("COMPONENT ABBREVIATION")) S FDA(1,6002.03,VBECIEN,7)=$G(PARAMS("COMPONENT ABBREVIATION"))
I $D(PARAMS("NUMBER OF UNITS")) S FDA(1,6002.03,VBECIEN,8)=$G(PARAMS("NUMBER OF UNITS"))
I $D(PARAMS("TRANSFUSION DATE")) S FDA(1,6002.03,VBECIEN,9)=+$G(PARAMS("TRANSFUSION DATE"))
S FDA(1,6002.03,VBECIEN,10)=$$NOW^XLFDT
I $D(PARAMS("VOLUME")) S FDA(1,6002.03,VBECIEN,11)=$G(PARAMS("VOLUME"))
I $D(PARAMS("REACTION TYPE")) S FDA(1,6002.03,VBECIEN,12)=$E($G(PARAMS("REACTION TYPE")),1,10) ;Limit input per conversation with David on 1/19
I $D(PARAMS("UNIT MODIFICATION")) S FDA(1,6002.03,VBECIEN,13)=$E($G(PARAMS("UNIT MODIFICATION")),1,6) ;Limit input per conversation with David on 1/19
I $D(PARAMS("REACTION")) S FDA(1,6002.03,VBECIEN,14)=$S($G(PARAMS("REACTION"))="True":"1",$G(PARAMS("REACTION"))="False":"",1:"") ;Leave room for a False code if necessary.
I 'VBECON D UPDATE^DIE("","FDA(1)",,"VBERR") ;W !,"NEW" ;For new record
I VBECON S:$G(FDA(1,6002.03,VBECIEN,1)) FDA(1,6002.03,VBECIEN,1)="`"_FDA(1,6002.03,VBECIEN,1) D FILE^DIE("E","FDA(1)","VBERR") ;W !,"UPDATE" zw ;To update existing record
D RESULT(1)
Q
;
TEST ; Test the update
;36785EB0-8BCF-4407-A6C8-0002329A4ABF
;1375FB52-EC30-453D-8FC7-00026DA1229A
;8EE67641-0BA6-4A0C-84B4-0003E3F95011
;AD082B9A-6EC8-4EA9-9B99-0005AA8FFBD7
;09F8325B-0E93-4EB8-A315-000615AF3F9C
;C6F51B1E-11B7-49F9-B919-000AA5E3EC82
;5B8CC626-C32D-4AE2-B13D-000A65A3C04E
;411AF601-822E-4F38-A0CE-001661042A6E
;E66DD96E-AA27-4F12-96F6-00171F5D13EE
S PARAMS("TRANSACTION ID")="E66DD96E-AA27-4F12-96F6-00171F5D13EE"
S PARAMS("DFN")=51
;S PARAMS("NAME")="BILLYFRED"
S PARAMS("FACILITY")="589 "
S PARAMS("PHYSICIAN")="DOC,ONE"
S PARAMS("ORDERING PROVIDER")=53296
S PARAMS("PRODUCT NAME")="RED BLOOD CELLS"
S PARAMS("COMPONENT ABBREVIATION")="RBC"
S PARAMS("NUMBER OF UNITS")=6
S PARAMS("TRANSFUSION DATE")=DT
S PARAMS("VOLUME")="500"
S PARAMS("REACTION TYPE")="FEBRILE"
S PARAMS("UNIT MODIFICATION")="IWG"
S PARAMS("REACTION")="True"
Q
;
RESULT(VALUE) ; -- Add return value
SET VBECLINE=VBECLINE+1
SET @VBECRSLT@(VBECLINE)="<ReturnValue><SuccessIndicator>"_VALUE_"</SuccessIndicator></ReturnValue>"
QUIT
TSTRIP(X) ;Strip trailing spaces
F Q:X'?.E1" " S X=$E(X,1,$L(X)-1)
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECDSS 3884 printed Dec 13, 2024@02:44:14 Page 2
VBECDSS ;;HOIFO/BNT-VBECS DSS Extract ;December 05, 2006
+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 QUIT
+8 ;
EN(RESULT,PARAMS) ; Main Entry point for RPC
+1 ; -- RPC: VBECS DSS EXTRACT
+2 ; -- INPUT: PARAMS Array containing values to be inserted or updated
+3 ; -- in the VBECS DSS EXTRACT File (#6002.03).
+4 ;
+5 NEW I,X,Y,VBECRSLT,VBECLINE,FDA,VBERR
+6 IF '$DATA(DT)
DO DT^DICRW
+7 SET VBECRSLT="^TMP(""VBEC_DSS_EXTRACT"",$J)"
SET VBECLINE=0
SET RESULT=$NAME(@VBECRSLT)
+8 KILL @RESULT
+9 IF '$DATA(PARAMS("TRANSACTION ID"))
DO RESULT(0)
QUIT
+10 SET VBECON=$$FIND1^DIC(6002.03,,,PARAMS("TRANSACTION ID"),,.ERROR)
+11 SET VBECIEN=$SELECT(VBECON:VBECON_",",1:"+1,")
+12 SET FDA(1,6002.03,VBECIEN,.01)=PARAMS("TRANSACTION ID")
+13 IF $DATA(PARAMS("DFN"))
IF PARAMS("DFN")
SET FDA(1,6002.03,VBECIEN,1)=$GET(PARAMS("DFN"))
+14 IF $DATA(PARAMS("ORDERING LOCATION"))
SET FDA(1,6002.03,VBECIEN,2)=$GET(PARAMS("ORDERING LOCATION"))
+15 IF $DATA(PARAMS("TRANSFUSION LOCATION"))
SET FDA(1,6002.03,VBECIEN,3)=$GET(PARAMS("TRANSFUSION LOCATION"))
+16 ;I $D(PARAMS("FACILITY")) S VBFAC=$$TSTRIP($G(PARAMS("FACILITY"))),VBFAC=$$FIND1^DIC(4,,"MX",VBFAC,,,"VBERR") D
+17 ;. S FDA(1,6002.03,VBECIEN,3)=VBFAC
+18 IF $DATA(PARAMS("PHYSICIAN"))
SET FDA(1,6002.03,VBECIEN,4)=$GET(PARAMS("PHYSICIAN"))
+19 IF $DATA(PARAMS("ORDERING PROVIDER"))
SET FDA(1,6002.03,VBECIEN,5)=$GET(PARAMS("ORDERING PROVIDER"))
+20 IF $DATA(PARAMS("PRODUCT NAME"))
SET FDA(1,6002.03,VBECIEN,6)=$GET(PARAMS("PRODUCT NAME"))
+21 IF $DATA(PARAMS("COMPONENT ABBREVIATION"))
SET FDA(1,6002.03,VBECIEN,7)=$GET(PARAMS("COMPONENT ABBREVIATION"))
+22 IF $DATA(PARAMS("NUMBER OF UNITS"))
SET FDA(1,6002.03,VBECIEN,8)=$GET(PARAMS("NUMBER OF UNITS"))
+23 IF $DATA(PARAMS("TRANSFUSION DATE"))
SET FDA(1,6002.03,VBECIEN,9)=+$GET(PARAMS("TRANSFUSION DATE"))
+24 SET FDA(1,6002.03,VBECIEN,10)=$$NOW^XLFDT
+25 IF $DATA(PARAMS("VOLUME"))
SET FDA(1,6002.03,VBECIEN,11)=$GET(PARAMS("VOLUME"))
+26 ;Limit input per conversation with David on 1/19
IF $DATA(PARAMS("REACTION TYPE"))
SET FDA(1,6002.03,VBECIEN,12)=$EXTRACT($GET(PARAMS("REACTION TYPE")),1,10)
+27 ;Limit input per conversation with David on 1/19
IF $DATA(PARAMS("UNIT MODIFICATION"))
SET FDA(1,6002.03,VBECIEN,13)=$EXTRACT($GET(PARAMS("UNIT MODIFICATION")),1,6)
+28 ;Leave room for a False code if necessary.
IF $DATA(PARAMS("REACTION"))
SET FDA(1,6002.03,VBECIEN,14)=$SELECT($GET(PARAMS("REACTION"))="True":"1",$GET(PARAMS("REACTION"))="False":"",1:"")
+29 ;W !,"NEW" ;For new record
IF 'VBECON
DO UPDATE^DIE("","FDA(1)",,"VBERR")
+30 ;W !,"UPDATE" zw ;To update existing record
IF VBECON
if $GET(FDA(1,6002.03,VBECIEN,1))
SET FDA(1,6002.03,VBECIEN,1)="`"_FDA(1,6002.03,VBECIEN,1)
DO FILE^DIE("E","FDA(1)","VBERR")
+31 DO RESULT(1)
+32 QUIT
+33 ;
TEST ; Test the update
+1 ;36785EB0-8BCF-4407-A6C8-0002329A4ABF
+2 ;1375FB52-EC30-453D-8FC7-00026DA1229A
+3 ;8EE67641-0BA6-4A0C-84B4-0003E3F95011
+4 ;AD082B9A-6EC8-4EA9-9B99-0005AA8FFBD7
+5 ;09F8325B-0E93-4EB8-A315-000615AF3F9C
+6 ;C6F51B1E-11B7-49F9-B919-000AA5E3EC82
+7 ;5B8CC626-C32D-4AE2-B13D-000A65A3C04E
+8 ;411AF601-822E-4F38-A0CE-001661042A6E
+9 ;E66DD96E-AA27-4F12-96F6-00171F5D13EE
+10 SET PARAMS("TRANSACTION ID")="E66DD96E-AA27-4F12-96F6-00171F5D13EE"
+11 SET PARAMS("DFN")=51
+12 ;S PARAMS("NAME")="BILLYFRED"
+13 SET PARAMS("FACILITY")="589 "
+14 SET PARAMS("PHYSICIAN")="DOC,ONE"
+15 SET PARAMS("ORDERING PROVIDER")=53296
+16 SET PARAMS("PRODUCT NAME")="RED BLOOD CELLS"
+17 SET PARAMS("COMPONENT ABBREVIATION")="RBC"
+18 SET PARAMS("NUMBER OF UNITS")=6
+19 SET PARAMS("TRANSFUSION DATE")=DT
+20 SET PARAMS("VOLUME")="500"
+21 SET PARAMS("REACTION TYPE")="FEBRILE"
+22 SET PARAMS("UNIT MODIFICATION")="IWG"
+23 SET PARAMS("REACTION")="True"
+24 QUIT
+25 ;
RESULT(VALUE) ; -- Add return value
+1 SET VBECLINE=VBECLINE+1
+2 SET @VBECRSLT@(VBECLINE)="<ReturnValue><SuccessIndicator>"_VALUE_"</SuccessIndicator></ReturnValue>"
+3 QUIT
TSTRIP(X) ;Strip trailing spaces
+1 FOR
if X'?.E1" "
QUIT
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+2 QUIT X
