VBECA7 ;DALOI/RLM - Workload API ; 8/18/04 10:40am
;;2.0;VBECS;**1**;Jun 05, 2015;Build 13
;
; 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:
; VBECS workload capture supported by IA 4627
; Reference to EN^MXMLPRSE supported by IA #4149
; Reference to $$FIND1^DIC supported by IA #2051
; Reference to UPDATE^DIE supported by IA #2053
;
QUIT
;
; ----------------------------------------------------------
; Private Method Supports IA 4767
; ----------------------------------------------------------
WKLDCAP() ;
S NEWWKLD=0
D INITV^VBECRPCC("VBECS Workload")
I +VBECPRMS("ERROR") S ARR("ERROR")=VBECPRMS("ERROR") Q
S VBECPRMS("PARAMS",1,"TYPE")="STRING"
S VBECPRMS("PARAMS",1,"VALUE")="P"
F I=1:0 D Q:'NEWWKLD
. S NEWWKLD=0
. S VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
. S VBECY=$NA(^TMP("VBECS_XML_RES",$J))
. K @VBECY
. D PARSE^VBECRPC1(.VBECPRMS,VBECY)
. I $D(@VBECY@("ERROR")) S ARR("ERROR")="1^"_@VBECY@("ERROR") S NEWWKLD=0 Q
. D PARSE
;
EXIT I $D(VBERR) S ARR("ERROR")="1^Errors encountered during parse"
K @VBECY,ATR,CBK,DIERR,ELE,FDA,OPTION,TEXT,VBECPRMS
K VBECRES,VBECSTAT,VBECY,VBERRA,VBERRB
Q '(+$D(ARR)) ;This will return a 1 for a successful transfer and load
PARSE ;The callbacks defined here will allow the MXMLPRSE API to place
;the data directly into file 6002.01
S CBK("STARTELEMENT")="STELE^VBECA7"
S CBK("ENDELEMENT")="ENELE^VBECA7"
S CBK("CHARACTERS")="CHAR^VBECA7"
S OPTION=""
D EN^MXMLPRSE(VBECY,.CBK,.OPTION)
Q
STELE(ELE,ATR) ;File the data for each attribute in the FDA array
;for use by the UPDATE^DIE Database Server API.
I $D(ATR) D
. I ELE["Trans",$D(ATR("id")) S FDA(1,6002.01,"+1,",.01)=ATR("id"),NEWWKLD=1
. I $D(ATR("type")) S FDA(1,6002.01,"+1,",1)=ATR("type")
. I $D(ATR("division")) S ATR("division")=$TR(ATR("division")," ",""),FDA(1,6002.01,"+1,",2)=$$FIND1^DIC(4,,"MX",ATR("division")) ;RLM 9/22/2010
. I $D(ATR("accessionArea")) D
. . S FDA(1,6002.01,"+1,",14)=ATR("accessionArea")
. I $D(ATR("dateTime")) S FDA(1,6002.01,"+1,",3)=ATR("dateTime")
. I $D(ATR("status")) S FDA(1,6002.01,"+1,",5)=ATR("status")
. I $D(ATR("code")) D
. . ;S FDA(1,6002.01,"+1,",6)=$$WKLDPTR(ATR("code"))
. . S FDA(1,6002.01,"+1,",6)=$$WKLDPTR1(ATR("code"),ATR("method")) ;RLM 6-3-10
. I $D(ATR("method")) D ;RLM 6-3-10
. . S FDA(1,6002.01,"+1,",7)=$$MTHDPTR(ATR("method")) ;RLM 6-3-10
. I $D(ATR("multiplyFactor")) S FDA(1,6002.01,"+1,",8)=ATR("multiplyFactor")
. I $D(ATR("dfn")) D
. . I $D(^DPT(ATR("dfn"),-9)) S ATR("dfn")=+^DPT(ATR("dfn"),-9)
. . I $D(^DPT(ATR("dfn"))) S FDA(1,6002.01,"+1,",9)=ATR("dfn")
. I $D(ATR("duz")) D
. . I $D(^VA(200,ATR("duz"))) S FDA(1,6002.01,"+1,",10)=ATR("duz")
. I $D(ATR("accessionNumber")) S FDA(1,6002.01,"+1,",11)=ATR("accessionNumber")
. I $D(ATR("testPerformed")) D
. . I ATR("testPerformed")["REFLEX TEST" S ATR("testPerformed")=+$O(^LAB(60,"B","VBEC PATIENT REFLEX TEST",0)) ;RLM 1/10/2018
. . I $D(^LAB(60,$$STRIP^XLFSTR(ATR("testPerformed")," "))) S FDA(1,6002.01,"+1,",12)=$$STRIP^XLFSTR(ATR("testPerformed")," ")
. I ELE["Unit",$D(ATR("id")) S FDA(1,6002.01,"+1,",13)=ATR("id")
Q
ENELE(ELE) ;Ignore the end of each element until the end of
;WorkloadTransactions is found. File the data at this point.
I ELE="WorkloadTransactions" D
. Q:'NEWWKLD
. D UPDATE^DIE("","FDA(1)",,"VBERR")
. ;We'll remove the Writes and handle the errors in a different way
. ;prior to release.
. I $D(VBERR) D ;W !,"An error has occurred with ID ",FDA(1,6002.01,"+1,",.01) D
. . S (VBERRA,VBERRB,VBERRC)="" F S VBERRA=$O(VBERR("DIERR",VBERRA)) Q:'VBERRA F S VBERRB=$O(VBERR("DIERR",VBERRA,"TEXT",VBERRB)) Q:'VBERRB S VBERRC=VBERRC+1,XMTEXT(VBERRC)=VBERR("DIERR",VBERRA,"TEXT",VBERRB) K DIERR,VBERR
. . S XMDUZ="VBECS Workload Event"
. . S XMSUB="VBECS Workload Event"
. . S XMTEXT="VBLN("
. . S XMY("G.VBECS INTERFACE ADMIN")=""
. . D ^XMD
. . ;S (VBERRA,VBERRB)="" F S VBERRA=$O(VBERR("DIERR",VBERRA)) Q:'VBERRA F S VBERRB=$O(VBERR("DIERR",VBERRA,"TEXT",VBERRB)) Q:'VBERRB S ARR("ERROR")="1^Errors encountered during parse" W !,VBERR("DIERR",VBERRA,"TEXT",VBERRB) K DIERR,VBERR
Q
CHAR(TEXT) ;This one isn't necessary, but we'll report an error
;if text is found.
S VBERR("DIERR",999999,"TEXT",999999)="TEXT was returned unexpectedly"
Q
WKLDPTR(CODE) ; Gets the pointer to the workload code file 64
I $L($P(CODE,".",2))'=5 D
. S VBSUFX=$P(CODE,".",2)
. F I=1:1 S VBSUFX=VBSUFX_" " Q:$L(VBSUFX)=5
. S $P(CODE,".",2)=VBSUFX
Q $S($D(^LAM("C",CODE)):$O(^LAM("C",CODE,0)),1:0)
Q
WKLDPTR1(CODE,CODE1) ; Gets the pointer to the workload code file 64 SWITCH TO E X-REF
S CODE=$P(CODE,"."),CODE1=$TR(CODE1,".","") S:'CODE1 CODE1="0000"
Q $S($D(^LAM("E",CODE_"."_CODE1)):$O(^LAM("E",CODE_"."_CODE1,0)),1:0)
Q
MTHDPTR(CODE) ; Gets the pointer to the workload code file 64
S LRSUF=$$FIND1^DIC(64.2,"","O","."_CODE_" ","C","","ERR")
Q $S(LRSUF:LRSUF,1:"") ;
; ----------------------------------------------------------
; Private Method Supports IA 4767
; ----------------------------------------------------------
UPDTWKLD ; Update VBECS Workload
D UPDTWKLD^VBECA7A
Q
TESTSET ;This sets up test data.
Q ;ZL VBECA7 D ZEOR,PARSE ;To test
S ^TMP("VBEC_XML_RES",$J,1)="<BloodBank><WorkloadTransactions><Transaction id=""FIRST"" type=""P"" division=""589"" dateTime=""3040614"" status=""S""><Workload code=""Acetone"" method=""ACUTE"" multiplyFactor=""1"" />"
S ^TMP("VBEC_XML_RES",$J,2)="<Patient dfn=""262768"" /><VbecsUser duz=""7"" /><Lab accessionNumber=""789"" testPerformed=""ABG"" /><Unit id=""A1"" /></Transaction></WorkloadTransactions>"
Q
;
ZEOR ;VBECA7
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECA7 5953 printed Apr 09, 2024@21:45:58 Page 2
VBECA7 ;DALOI/RLM - Workload API ; 8/18/04 10:40am
+1 ;;2.0;VBECS;**1**;Jun 05, 2015;Build 13
+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 ; VBECS workload capture supported by IA 4627
+9 ; Reference to EN^MXMLPRSE supported by IA #4149
+10 ; Reference to $$FIND1^DIC supported by IA #2051
+11 ; Reference to UPDATE^DIE supported by IA #2053
+12 ;
+13 QUIT
+14 ;
+15 ; ----------------------------------------------------------
+16 ; Private Method Supports IA 4767
+17 ; ----------------------------------------------------------
WKLDCAP() ;
+1 SET NEWWKLD=0
+2 DO INITV^VBECRPCC("VBECS Workload")
+3 IF +VBECPRMS("ERROR")
SET ARR("ERROR")=VBECPRMS("ERROR")
QUIT
+4 SET VBECPRMS("PARAMS",1,"TYPE")="STRING"
+5 SET VBECPRMS("PARAMS",1,"VALUE")="P"
+6 FOR I=1:0
Begin DoDot:1
+7 SET NEWWKLD=0
+8 SET VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
+9 SET VBECY=$NAME(^TMP("VBECS_XML_RES",$JOB))
+10 KILL @VBECY
+11 DO PARSE^VBECRPC1(.VBECPRMS,VBECY)
+12 IF $DATA(@VBECY@("ERROR"))
SET ARR("ERROR")="1^"_@VBECY@("ERROR")
SET NEWWKLD=0
QUIT
+13 DO PARSE
End DoDot:1
if 'NEWWKLD
QUIT
+14 ;
EXIT IF $DATA(VBERR)
SET ARR("ERROR")="1^Errors encountered during parse"
+1 KILL @VBECY,ATR,CBK,DIERR,ELE,FDA,OPTION,TEXT,VBECPRMS
+2 KILL VBECRES,VBECSTAT,VBECY,VBERRA,VBERRB
+3 ;This will return a 1 for a successful transfer and load
QUIT '(+$DATA(ARR))
PARSE ;The callbacks defined here will allow the MXMLPRSE API to place
+1 ;the data directly into file 6002.01
+2 SET CBK("STARTELEMENT")="STELE^VBECA7"
+3 SET CBK("ENDELEMENT")="ENELE^VBECA7"
+4 SET CBK("CHARACTERS")="CHAR^VBECA7"
+5 SET OPTION=""
+6 DO EN^MXMLPRSE(VBECY,.CBK,.OPTION)
+7 QUIT
STELE(ELE,ATR) ;File the data for each attribute in the FDA array
+1 ;for use by the UPDATE^DIE Database Server API.
+2 IF $DATA(ATR)
Begin DoDot:1
+3 IF ELE["Trans"
IF $DATA(ATR("id"))
SET FDA(1,6002.01,"+1,",.01)=ATR("id")
SET NEWWKLD=1
+4 IF $DATA(ATR("type"))
SET FDA(1,6002.01,"+1,",1)=ATR("type")
+5 ;RLM 9/22/2010
IF $DATA(ATR("division"))
SET ATR("division")=$TRANSLATE(ATR("division")," ","")
SET FDA(1,6002.01,"+1,",2)=$$FIND1^DIC(4,,"MX",ATR("division"))
+6 IF $DATA(ATR("accessionArea"))
Begin DoDot:2
+7 SET FDA(1,6002.01,"+1,",14)=ATR("accessionArea")
End DoDot:2
+8 IF $DATA(ATR("dateTime"))
SET FDA(1,6002.01,"+1,",3)=ATR("dateTime")
+9 IF $DATA(ATR("status"))
SET FDA(1,6002.01,"+1,",5)=ATR("status")
+10 IF $DATA(ATR("code"))
Begin DoDot:2
+11 ;S FDA(1,6002.01,"+1,",6)=$$WKLDPTR(ATR("code"))
+12 ;RLM 6-3-10
SET FDA(1,6002.01,"+1,",6)=$$WKLDPTR1(ATR("code"),ATR("method"))
End DoDot:2
+13 ;RLM 6-3-10
IF $DATA(ATR("method"))
Begin DoDot:2
+14 ;RLM 6-3-10
SET FDA(1,6002.01,"+1,",7)=$$MTHDPTR(ATR("method"))
End DoDot:2
+15 IF $DATA(ATR("multiplyFactor"))
SET FDA(1,6002.01,"+1,",8)=ATR("multiplyFactor")
+16 IF $DATA(ATR("dfn"))
Begin DoDot:2
+17 IF $DATA(^DPT(ATR("dfn"),-9))
SET ATR("dfn")=+^DPT(ATR("dfn"),-9)
+18 IF $DATA(^DPT(ATR("dfn")))
SET FDA(1,6002.01,"+1,",9)=ATR("dfn")
End DoDot:2
+19 IF $DATA(ATR("duz"))
Begin DoDot:2
+20 IF $DATA(^VA(200,ATR("duz")))
SET FDA(1,6002.01,"+1,",10)=ATR("duz")
End DoDot:2
+21 IF $DATA(ATR("accessionNumber"))
SET FDA(1,6002.01,"+1,",11)=ATR("accessionNumber")
+22 IF $DATA(ATR("testPerformed"))
Begin DoDot:2
+23 ;RLM 1/10/2018
IF ATR("testPerformed")["REFLEX TEST"
SET ATR("testPerformed")=+$ORDER(^LAB(60,"B","VBEC PATIENT REFLEX TEST",0))
+24 IF $DATA(^LAB(60,$$STRIP^XLFSTR(ATR("testPerformed")," ")))
SET FDA(1,6002.01,"+1,",12)=$$STRIP^XLFSTR(ATR("testPerformed")," ")
End DoDot:2
+25 IF ELE["Unit"
IF $DATA(ATR("id"))
SET FDA(1,6002.01,"+1,",13)=ATR("id")
End DoDot:1
+26 QUIT
ENELE(ELE) ;Ignore the end of each element until the end of
+1 ;WorkloadTransactions is found. File the data at this point.
+2 IF ELE="WorkloadTransactions"
Begin DoDot:1
+3 if 'NEWWKLD
QUIT
+4 DO UPDATE^DIE("","FDA(1)",,"VBERR")
+5 ;We'll remove the Writes and handle the errors in a different way
+6 ;prior to release.
+7 ;W !,"An error has occurred with ID ",FDA(1,6002.01,"+1,",.01) D
IF $DATA(VBERR)
Begin DoDot:2
+8 SET (VBERRA,VBERRB,VBERRC)=""
FOR
SET VBERRA=$ORDER(VBERR("DIERR",VBERRA))
if 'VBERRA
QUIT
FOR
SET VBERRB=$ORDER(VBERR("DIERR",VBERRA,"TEXT",VBERRB))
if 'VBERRB
QUIT
SET VBERRC=VBERRC+1
SET XMTEXT(VBERRC)=VBERR("DIERR",VBERRA,"TEXT",VBERRB)
KILL DIERR,VBERR
+9 SET XMDUZ="VBECS Workload Event"
+10 SET XMSUB="VBECS Workload Event"
+11 SET XMTEXT="VBLN("
+12 SET XMY("G.VBECS INTERFACE ADMIN")=""
+13 DO ^XMD
+14 ;S (VBERRA,VBERRB)="" F S VBERRA=$O(VBERR("DIERR",VBERRA)) Q:'VBERRA F S VBERRB=$O(VBERR("DIERR",VBERRA,"TEXT",VBERRB)) Q:'VBERRB S ARR("ERROR")="1^Errors encountered during parse" W !,VBERR("DIERR",VBERRA,"TEXT",VBERRB) K DIERR,VBERR
End DoDot:2
End DoDot:1
+15 QUIT
CHAR(TEXT) ;This one isn't necessary, but we'll report an error
+1 ;if text is found.
+2 SET VBERR("DIERR",999999,"TEXT",999999)="TEXT was returned unexpectedly"
+3 QUIT
WKLDPTR(CODE) ; Gets the pointer to the workload code file 64
+1 IF $LENGTH($PIECE(CODE,".",2))'=5
Begin DoDot:1
+2 SET VBSUFX=$PIECE(CODE,".",2)
+3 FOR I=1:1
SET VBSUFX=VBSUFX_" "
if $LENGTH(VBSUFX)=5
QUIT
+4 SET $PIECE(CODE,".",2)=VBSUFX
End DoDot:1
+5 QUIT $SELECT($DATA(^LAM("C",CODE)):$ORDER(^LAM("C",CODE,0)),1:0)
+6 QUIT
WKLDPTR1(CODE,CODE1) ; Gets the pointer to the workload code file 64 SWITCH TO E X-REF
+1 SET CODE=$PIECE(CODE,".")
SET CODE1=$TRANSLATE(CODE1,".","")
if 'CODE1
SET CODE1="0000"
+2 QUIT $SELECT($DATA(^LAM("E",CODE_"."_CODE1)):$ORDER(^LAM("E",CODE_"."_CODE1,0)),1:0)
+3 QUIT
MTHDPTR(CODE) ; Gets the pointer to the workload code file 64
+1 SET LRSUF=$$FIND1^DIC(64.2,"","O","."_CODE_" ","C","","ERR")
+2 ;
QUIT $SELECT(LRSUF:LRSUF,1:"")
+3 ; ----------------------------------------------------------
+4 ; Private Method Supports IA 4767
+5 ; ----------------------------------------------------------
UPDTWKLD ; Update VBECS Workload
+1 DO UPDTWKLD^VBECA7A
+2 QUIT
TESTSET ;This sets up test data.
+1 ;ZL VBECA7 D ZEOR,PARSE ;To test
QUIT
+2 SET ^TMP("VBEC_XML_RES",$JOB,1)="<BloodBank><WorkloadTransactions><Transaction id=""FIRST"" type=""P"" division=""589"" dateTime=""3040614"" status=""S""><Workload code=""Acetone"" method=""ACUTE"" multiplyFactor=""1"" />"
+3 SET ^TMP("VBEC_XML_RES",$JOB,2)="<Patient dfn=""262768"" /><VbecsUser duz=""7"" /><Lab accessionNumber=""789"" testPerformed=""ABG"" /><Unit id=""A1"" /></Transaction></WorkloadTransactions>"
+4 QUIT
+5 ;
ZEOR ;VBECA7
