VBECA7B ;HOIFO/SAE - Workload API ; 9/10/04 1:46pm
;;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:
;
QUIT
;
CHKERROR(VBECPRMS,VBRSLT,VBFATAL,VBMT) ; check for error in results
W !,"CHKERROR:" ;
;
; Input
; VBECPRMS - array
; VBRSLT - name of ^TMP results global
; VBFATAL - fatal error flag
; VBMT - name of message text global
; Output
; VBFATAL - flag to set to true if error has occurred
; VBMT - message text global to build onto
;
N VBX ; temporary variable for holding text
;
; error where ^TMP results global is malformed where it looks like:
; ^TMP("VBECS_XML_RES",541084121,1) = ???<?xml version="1.0" ... etc.
; this error cannot be checked in STELE(not called in this situation)
I '$D(@VBMT@(" ERROR")) D
. I $G(VBECPRMS("ERROR"))'=0 D Q
. . S VBFATAL=1
. . S VBX=" returned by INITV~VBECRPCC"
. . S @VBMT@(" ERROR")="ERROR: "_VBECPRMS("ERROR")_VBX
. I $P($G(@VBRSLT@(1)),"<")?1."?" D
. . S VBFATAL=1
. . S VBX=" returned by PARSE~VBECRPC1"
. . S @VBMT@(" ERROR")="ERROR: MALFORMED RESULTS GLOBAL"_VBX
. I $D(@VBRSLT@("ERROR")) D Q
. . S VBFATAL=1
. . S VBX=" returned by EN^MXMLPRSE parser - caught by callback"
. . S @VBMT@(" ERROR")="ERROR: "_@VBRSLT@("ERROR")_VBX
Q
;
BLDERMSG(VBECPRMS,VBRSLT,VBMT) ;
W !,"BLDERMSG:"
;
N VBX ; temporary variable for holding text
N VBNM ; indirect name of request/results array/global
N VBNM2 ; copy of VBNM for different FOR loop
N VBNMORIG ; copy of VBNM with trailing parenthesis removed
N VBDATA ; data value from request/results node
N VBLBL ; label value comprised of $NA_VBDATA
N VBSUB ; subscript value for array node
N VBOUT ; full concatenated value of node to display
N VBLCV ; loop control variable for FOR loop
N VBDONE ; flag to signify 'done' with loop
N VBBLANK ; blank line of blank spaces
N VBMAXDAT ; maximum allowable length of array node data value
N VBMAXLBL ; maximum discovered length of array node label value
N VBSPACES ; calulated gap to format display to show data at column
;
S VBX="Following are the request and results array(s):"
S @VBMT@(" FOLLOWS MSG")=VBX
S VBBLANK=" "
;
F VBNM="VBECPRMS",$NA(@VBRSLT) D
. S VBNM2=VBNM,VBNMORIG=$P(VBNM,")")
. S VBMAXLBL=1
. F S VBNM2=$Q(@VBNM2) Q:VBNM2="" Q:$NA(@VBNM2)'[VBNMORIG D
. . S:VBNMORIG="VBECPRMS" VBLBL=$P($NA(@VBNM2),"(",2)
. . S:VBNMORIG=$P($NA(@VBRSLT),")") VBLBL=$P($NA(@VBNM2),")")
. . I VBNMORIG["VBECPRMS" D
. . . S VBLBL=$P(VBLBL,")")
. . I VBNMORIG'["VBECPRMS" D
. . . S VBLBL=$P(VBLBL,"(",2)
. . . S VBLBL=$P(VBLBL,$J)_$E(VBLBL,$F(VBLBL,$J)+1,$L(VBLBL))
. . . S VBLBL=$TR(VBLBL,"""","'"),VBLBL="'"_$P(VBLBL,"XML_",2)
. . S VBMAXLBL=$S($L(VBLBL)>VBMAXLBL:$L(VBLBL),1:VBMAXLBL)
. S VBMAXLBL=$S(VBMAXLBL>30:30,1:VBMAXLBL+3)
. S VBMAXDAT=80-VBMAXLBL-2
. S VBNMORIG=$P(VBNM,")")
. F S VBNM=$Q(@VBNM) Q:VBNM="" Q:$NA(@VBNM)'[VBNMORIG D
. . S VBLCV=0
. . S VBSUB=$NA(@VBNM),VBSUB=$TR(VBSUB,"""","")
. . S:VBNMORIG="VBECPRMS" VBLBL=$P($NA(@VBNM),"(",2)
. . S:VBNMORIG=$P($NA(@VBRSLT),")") VBLBL=$P($NA(@VBNM),")")
. . I VBNMORIG["VBECPRMS" D
. . . S VBLBL=$P(VBLBL,")")
. . I VBNMORIG'["VBECPRMS" D
. . . S VBLBL=$P(VBLBL,"(",2)
. . . S VBLBL=$P(VBLBL,$J)_$E(VBLBL,$F(VBLBL,$J)+1,$L(VBLBL))
. . . S VBLBL=$TR(VBLBL,"""","'"),VBLBL="'"_$P(VBLBL,"XML_",2)
. . S VBSPACES="",$P(VBSPACES," ",VBMAXLBL-$L(VBLBL))=""
. . S VBSPACES=VBSPACES
. . S VBDATA=$G(@VBNM)
. . K VBDONE
. . F VBLCV=0:1:25 D Q:$D(VBDONE)
. . . S VBSUB=$P(VBSUB,"||")
. . . S VBSUB=VBSUB_"||"_VBLCV
. . . S VBDATA(VBLCV)=" "_$E(VBDATA,1,VBMAXDAT)
. . . S VBDATA=$E(VBDATA,VBMAXDAT+1,$L(VBDATA))
. . . S:$L(VBDATA)'>0 VBDONE=1
. . . ;
. . . I VBLCV<1 D Q
. . . . I $L(VBLBL)'>VBMAXLBL D Q
. . . . . S $P(VBSPACES," ",$L(VBLBL)-VBMAXLBL)=""
. . . . . S VBLBL=VBLBL_VBSPACES
. . . . . S VBOUT=VBLBL_VBDATA(VBLCV)
. . . . . S @VBMT@(VBSUB)=VBOUT
. . . . I $L(VBLBL)>VBMAXLBL D
. . . . . S @VBMT@(VBSUB)=VBLBL
. . . . . S VBSUB=VBSUB_"||"_VBLCV
. . . . . S VBLBL=$E(VBBLANK,1,VBMAXLBL-1)
. . . . . S VBOUT=VBLBL_VBDATA(VBLCV)
. . . . . S VBSUB=$P(VBSUB,"||")
. . . . . S VBLCV=VBLCV+1
. . . . . S VBSUB=VBSUB_"||"_VBLCV
. . . . . S @VBMT@(VBSUB)=VBOUT
. . . ;
. . . I VBLCV>0 D
. . . . S VBLBL=$E(VBBLANK,1,VBMAXLBL-1)
. . . . S VBOUT=VBLBL_VBDATA(VBLCV)
. . . . S @VBMT@(VBSUB)=VBOUT
K VBDATA
Q
;
STELE(ELE,ATR) ; Find attribute value
W !,"STELE:"
;
; Input
; ELE - Element, as defined in Document Type Descriptor
; ATR - Attribute array, as defined in Document Type Descriptor
; Output
; VBIEN - IEN of VBECS WORKLOAD CAPTURE (#6002.01) file
; VBID - TRANSACTION ID
; VBFATAL - VBECS error msg. If undefined, no error occurred
; VBIENERR - Error message from failure to $$FIND entry in file
; VBMT - Result array for mail text to be sent to mail group
;
K VBIENERR
N VBX ; temporary variable for various uses
N VBBEG ; beginning character of text value in XML string
N VBEND ; ending character of text value in XML string
N VBERMSG ; error text message
;
Q:$D(@VBMT@(" ERROR")) ; an error has already been identified
Q:$D(@VBRSLT@("ERROR")) ; standard ^TMP "ERROR" - caught by CHKERROR
;
;
I $L(ELE)'>0 D Q
. S VBFATAL=1
. S VBX="ERROR: No ELEMENT received from parsing routine"
. S @VBMT@(" ERROR")="ERROR: "_VBX
;
I ELE["WorkloadEvent" D
. I $D(ATR("successfullyUpdated")) D
. . I $D(ATR("id")) D
. . . S VBX="TRANSACTION ID: "_ATR("id")_U_ATR("id")
. . . S @VBMT@("TRANSACTION ID")=VBX
. . . S VBIEN=$$FIND1^DIC(6002.01,"","QX",ATR("id"),"","","VBIENERR")
. . . I VBIEN?1.N,VBIEN>0 D
. . . . S @VBMT@("VISTA IEN")="DERIVED VISTA IEN: "_VBIEN_U_VBIEN
. . I '$D(ATR("id")) D
. . . S VBFATAL=1
. . . S VBX="No Txn ID accompanied the successfullyUpdated attribute"
. . . S @VBMT@(" ERROR")="ERROR: "_VBX
. . . S @VBMT@("VISTA UPDATE NOT ATTEMPTED - NO ID")=VBX
;
Q
;
ENELE(ELE) ; Ignore end of each element until end of WorkloadTransactions
W !,"ENELE:"
;
; Input:
; ELE - element name from VBECS
;
N VBMT ; name of global containing mailman message text
N VBTEXT ; text from ErrorText element
N VBTXNID ; transaction id from @VBMT@("TRANSACTION ID")
N VBIEN ; IEN of entry to update for failure edits
N VBFDA ; array for FILE^DIE
N VBX ; temporary variable for various uses
N VBERRMSG ; error message from FILE^DIE
N VBLUERR ; lookup error from $$FIND
;
S VBMT=$NA(^TMP("VBECS_MAIL_TEXT",$J))
;
Q:$D(@VBMT@(" ERROR")) ; an error has already been identified
;
Q:ELE'="WorkloadTransactions"
;
I $D(@VBMT@("SUCCESS FROM VBECS")) D
. I $D(@VBMT@("VISTA IEN")) D
. . S DIK="^VBEC(6002.01,"
. . S DA=$P(@VBMT@("VISTA IEN"),U,2)
. . D ^DIK K DA,DIC,DIK
. . S VBX="VistA entry # "_DA_" was deleted."
. . S @VBMT@("VISTA UPDATE - ENTRY DELETED")=VBX
. I '$D(@VBMT@("VISTA IEN")) D
. . S VBX="No VistA update attempted because no IEN was retreived"
. . S @VBMT@("VISTA UPDATE - UPDATE NOT ATTEMPTED")=VBX
;
I $D(@VBMT@("VBECS ERROR TEXT")) D
. I $D(@VBMT@("VISTA IEN")) D
. . S VBIEN=$P(@VBMT@("VISTA IEN"),U,2)
. . Q:VBIEN'?1.N
. . S VBFDA(6002.01,VBIEN_",",5)="E"
. . S VBFDA(6002.01,VBIEN_",",20)=@VBMT@("VBECS ERROR TEXT")
. . D FILE^DIE("","VBFDA","VBERRMSG")
. . I '$D(VBERRMSG) D
. . . S VBX="Entry # "_VBIEN_" was updated"
. . . S @VBMT@("VISTA UPDATE - ENTRY UPDATED")=VBX
. . I $D(VBERRMSG) D
. . . S VBFATAL=1
. . . S VBX=$G(VBERRMSG("DIERR",1,"TEXT",1))
. . . S @VBMT@(" ERROR")="ERROR: "_VBX
. . . S @VBMT@("VISTA UPDATE - UPDATE FAILED")=VBX
. I '$D(@VBMT@("VISTA IEN")) D
. . S VBFATAL=1
. . S VBX="No VistA update attempted (no IEN)"
. . S @VBMT@(" ERROR")="ERROR: "_VBX
. . S @VBMT@("VISTA UPDATE NOT ATTEMPTED")=VBX
Q
;
CHAR(TEXT) ;
Q:$D(@VBMT@(" ERROR"))
;
I XML["ErrorText" D
. S @VBMT@("VBECS ERROR TEXT")="VBECS 'ErrorText' message: "_TEXT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECA7B 8441 printed Sep 23, 2025@20:20:02 Page 2
VBECA7B ;HOIFO/SAE - Workload API ; 9/10/04 1:46pm
+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 ; Integration Agreements:
+8 ;
+9 QUIT
+10 ;
CHKERROR(VBECPRMS,VBRSLT,VBFATAL,VBMT) ; check for error in results
+1 ;
WRITE !,"CHKERROR:"
+2 ;
+3 ; Input
+4 ; VBECPRMS - array
+5 ; VBRSLT - name of ^TMP results global
+6 ; VBFATAL - fatal error flag
+7 ; VBMT - name of message text global
+8 ; Output
+9 ; VBFATAL - flag to set to true if error has occurred
+10 ; VBMT - message text global to build onto
+11 ;
+12 ; temporary variable for holding text
NEW VBX
+13 ;
+14 ; error where ^TMP results global is malformed where it looks like:
+15 ; ^TMP("VBECS_XML_RES",541084121,1) = ???<?xml version="1.0" ... etc.
+16 ; this error cannot be checked in STELE(not called in this situation)
+17 IF '$DATA(@VBMT@(" ERROR"))
Begin DoDot:1
+18 IF $GET(VBECPRMS("ERROR"))'=0
Begin DoDot:2
+19 SET VBFATAL=1
+20 SET VBX=" returned by INITV~VBECRPCC"
+21 SET @VBMT@(" ERROR")="ERROR: "_VBECPRMS("ERROR")_VBX
End DoDot:2
QUIT
+22 IF $PIECE($GET(@VBRSLT@(1)),"<")?1."?"
Begin DoDot:2
+23 SET VBFATAL=1
+24 SET VBX=" returned by PARSE~VBECRPC1"
+25 SET @VBMT@(" ERROR")="ERROR: MALFORMED RESULTS GLOBAL"_VBX
End DoDot:2
+26 IF $DATA(@VBRSLT@("ERROR"))
Begin DoDot:2
+27 SET VBFATAL=1
+28 SET VBX=" returned by EN^MXMLPRSE parser - caught by callback"
+29 SET @VBMT@(" ERROR")="ERROR: "_@VBRSLT@("ERROR")_VBX
End DoDot:2
QUIT
End DoDot:1
+30 QUIT
+31 ;
BLDERMSG(VBECPRMS,VBRSLT,VBMT) ;
+1 WRITE !,"BLDERMSG:"
+2 ;
+3 ; temporary variable for holding text
NEW VBX
+4 ; indirect name of request/results array/global
NEW VBNM
+5 ; copy of VBNM for different FOR loop
NEW VBNM2
+6 ; copy of VBNM with trailing parenthesis removed
NEW VBNMORIG
+7 ; data value from request/results node
NEW VBDATA
+8 ; label value comprised of $NA_VBDATA
NEW VBLBL
+9 ; subscript value for array node
NEW VBSUB
+10 ; full concatenated value of node to display
NEW VBOUT
+11 ; loop control variable for FOR loop
NEW VBLCV
+12 ; flag to signify 'done' with loop
NEW VBDONE
+13 ; blank line of blank spaces
NEW VBBLANK
+14 ; maximum allowable length of array node data value
NEW VBMAXDAT
+15 ; maximum discovered length of array node label value
NEW VBMAXLBL
+16 ; calulated gap to format display to show data at column
NEW VBSPACES
+17 ;
+18 SET VBX="Following are the request and results array(s):"
+19 SET @VBMT@(" FOLLOWS MSG")=VBX
+20 SET VBBLANK=" "
+21 ;
+22 FOR VBNM="VBECPRMS",$NAME(@VBRSLT)
Begin DoDot:1
+23 SET VBNM2=VBNM
SET VBNMORIG=$PIECE(VBNM,")")
+24 SET VBMAXLBL=1
+25 FOR
SET VBNM2=$QUERY(@VBNM2)
if VBNM2=""
QUIT
if $NAME(@VBNM2)'[VBNMORIG
QUIT
Begin DoDot:2
+26 if VBNMORIG="VBECPRMS"
SET VBLBL=$PIECE($NAME(@VBNM2),"(",2)
+27 if VBNMORIG=$PIECE($NAME(@VBRSLT),")")
SET VBLBL=$PIECE($NAME(@VBNM2),")")
+28 IF VBNMORIG["VBECPRMS"
Begin DoDot:3
+29 SET VBLBL=$PIECE(VBLBL,")")
End DoDot:3
+30 IF VBNMORIG'["VBECPRMS"
Begin DoDot:3
+31 SET VBLBL=$PIECE(VBLBL,"(",2)
+32 SET VBLBL=$PIECE(VBLBL,$JOB)_$EXTRACT(VBLBL,$FIND(VBLBL,$JOB)+1,$LENGTH(VBLBL))
+33 SET VBLBL=$TRANSLATE(VBLBL,"""","'")
SET VBLBL="'"_$PIECE(VBLBL,"XML_",2)
End DoDot:3
+34 SET VBMAXLBL=$SELECT($LENGTH(VBLBL)>VBMAXLBL:$LENGTH(VBLBL),1:VBMAXLBL)
End DoDot:2
+35 SET VBMAXLBL=$SELECT(VBMAXLBL>30:30,1:VBMAXLBL+3)
+36 SET VBMAXDAT=80-VBMAXLBL-2
+37 SET VBNMORIG=$PIECE(VBNM,")")
+38 FOR
SET VBNM=$QUERY(@VBNM)
if VBNM=""
QUIT
if $NAME(@VBNM)'[VBNMORIG
QUIT
Begin DoDot:2
+39 SET VBLCV=0
+40 SET VBSUB=$NAME(@VBNM)
SET VBSUB=$TRANSLATE(VBSUB,"""","")
+41 if VBNMORIG="VBECPRMS"
SET VBLBL=$PIECE($NAME(@VBNM),"(",2)
+42 if VBNMORIG=$PIECE($NAME(@VBRSLT),")")
SET VBLBL=$PIECE($NAME(@VBNM),")")
+43 IF VBNMORIG["VBECPRMS"
Begin DoDot:3
+44 SET VBLBL=$PIECE(VBLBL,")")
End DoDot:3
+45 IF VBNMORIG'["VBECPRMS"
Begin DoDot:3
+46 SET VBLBL=$PIECE(VBLBL,"(",2)
+47 SET VBLBL=$PIECE(VBLBL,$JOB)_$EXTRACT(VBLBL,$FIND(VBLBL,$JOB)+1,$LENGTH(VBLBL))
+48 SET VBLBL=$TRANSLATE(VBLBL,"""","'")
SET VBLBL="'"_$PIECE(VBLBL,"XML_",2)
End DoDot:3
+49 SET VBSPACES=""
SET $PIECE(VBSPACES," ",VBMAXLBL-$LENGTH(VBLBL))=""
+50 SET VBSPACES=VBSPACES
+51 SET VBDATA=$GET(@VBNM)
+52 KILL VBDONE
+53 FOR VBLCV=0:1:25
Begin DoDot:3
+54 SET VBSUB=$PIECE(VBSUB,"||")
+55 SET VBSUB=VBSUB_"||"_VBLCV
+56 SET VBDATA(VBLCV)=" "_$EXTRACT(VBDATA,1,VBMAXDAT)
+57 SET VBDATA=$EXTRACT(VBDATA,VBMAXDAT+1,$LENGTH(VBDATA))
+58 if $LENGTH(VBDATA)'>0
SET VBDONE=1
+59 ;
+60 IF VBLCV<1
Begin DoDot:4
+61 IF $LENGTH(VBLBL)'>VBMAXLBL
Begin DoDot:5
+62 SET $PIECE(VBSPACES," ",$LENGTH(VBLBL)-VBMAXLBL)=""
+63 SET VBLBL=VBLBL_VBSPACES
+64 SET VBOUT=VBLBL_VBDATA(VBLCV)
+65 SET @VBMT@(VBSUB)=VBOUT
End DoDot:5
QUIT
+66 IF $LENGTH(VBLBL)>VBMAXLBL
Begin DoDot:5
+67 SET @VBMT@(VBSUB)=VBLBL
+68 SET VBSUB=VBSUB_"||"_VBLCV
+69 SET VBLBL=$EXTRACT(VBBLANK,1,VBMAXLBL-1)
+70 SET VBOUT=VBLBL_VBDATA(VBLCV)
+71 SET VBSUB=$PIECE(VBSUB,"||")
+72 SET VBLCV=VBLCV+1
+73 SET VBSUB=VBSUB_"||"_VBLCV
+74 SET @VBMT@(VBSUB)=VBOUT
End DoDot:5
End DoDot:4
QUIT
+75 ;
+76 IF VBLCV>0
Begin DoDot:4
+77 SET VBLBL=$EXTRACT(VBBLANK,1,VBMAXLBL-1)
+78 SET VBOUT=VBLBL_VBDATA(VBLCV)
+79 SET @VBMT@(VBSUB)=VBOUT
End DoDot:4
End DoDot:3
if $DATA(VBDONE)
QUIT
End DoDot:2
End DoDot:1
+80 KILL VBDATA
+81 QUIT
+82 ;
STELE(ELE,ATR) ; Find attribute value
+1 WRITE !,"STELE:"
+2 ;
+3 ; Input
+4 ; ELE - Element, as defined in Document Type Descriptor
+5 ; ATR - Attribute array, as defined in Document Type Descriptor
+6 ; Output
+7 ; VBIEN - IEN of VBECS WORKLOAD CAPTURE (#6002.01) file
+8 ; VBID - TRANSACTION ID
+9 ; VBFATAL - VBECS error msg. If undefined, no error occurred
+10 ; VBIENERR - Error message from failure to $$FIND entry in file
+11 ; VBMT - Result array for mail text to be sent to mail group
+12 ;
+13 KILL VBIENERR
+14 ; temporary variable for various uses
NEW VBX
+15 ; beginning character of text value in XML string
NEW VBBEG
+16 ; ending character of text value in XML string
NEW VBEND
+17 ; error text message
NEW VBERMSG
+18 ;
+19 ; an error has already been identified
if $DATA(@VBMT@(" ERROR"))
QUIT
+20 ; standard ^TMP "ERROR" - caught by CHKERROR
if $DATA(@VBRSLT@("ERROR"))
QUIT
+21 ;
+22 ;
+23 IF $LENGTH(ELE)'>0
Begin DoDot:1
+24 SET VBFATAL=1
+25 SET VBX="ERROR: No ELEMENT received from parsing routine"
+26 SET @VBMT@(" ERROR")="ERROR: "_VBX
End DoDot:1
QUIT
+27 ;
+28 IF ELE["WorkloadEvent"
Begin DoDot:1
+29 IF $DATA(ATR("successfullyUpdated"))
Begin DoDot:2
+30 IF $DATA(ATR("id"))
Begin DoDot:3
+31 SET VBX="TRANSACTION ID: "_ATR("id")_U_ATR("id")
+32 SET @VBMT@("TRANSACTION ID")=VBX
+33 SET VBIEN=$$FIND1^DIC(6002.01,"","QX",ATR("id"),"","","VBIENERR")
+34 IF VBIEN?1.N
IF VBIEN>0
Begin DoDot:4
+35 SET @VBMT@("VISTA IEN")="DERIVED VISTA IEN: "_VBIEN_U_VBIEN
End DoDot:4
End DoDot:3
+36 IF '$DATA(ATR("id"))
Begin DoDot:3
+37 SET VBFATAL=1
+38 SET VBX="No Txn ID accompanied the successfullyUpdated attribute"
+39 SET @VBMT@(" ERROR")="ERROR: "_VBX
+40 SET @VBMT@("VISTA UPDATE NOT ATTEMPTED - NO ID")=VBX
End DoDot:3
End DoDot:2
End DoDot:1
+41 ;
+42 QUIT
+43 ;
ENELE(ELE) ; Ignore end of each element until end of WorkloadTransactions
+1 WRITE !,"ENELE:"
+2 ;
+3 ; Input:
+4 ; ELE - element name from VBECS
+5 ;
+6 ; name of global containing mailman message text
NEW VBMT
+7 ; text from ErrorText element
NEW VBTEXT
+8 ; transaction id from @VBMT@("TRANSACTION ID")
NEW VBTXNID
+9 ; IEN of entry to update for failure edits
NEW VBIEN
+10 ; array for FILE^DIE
NEW VBFDA
+11 ; temporary variable for various uses
NEW VBX
+12 ; error message from FILE^DIE
NEW VBERRMSG
+13 ; lookup error from $$FIND
NEW VBLUERR
+14 ;
+15 SET VBMT=$NAME(^TMP("VBECS_MAIL_TEXT",$JOB))
+16 ;
+17 ; an error has already been identified
if $DATA(@VBMT@(" ERROR"))
QUIT
+18 ;
+19 if ELE'="WorkloadTransactions"
QUIT
+20 ;
+21 IF $DATA(@VBMT@("SUCCESS FROM VBECS"))
Begin DoDot:1
+22 IF $DATA(@VBMT@("VISTA IEN"))
Begin DoDot:2
+23 SET DIK="^VBEC(6002.01,"
+24 SET DA=$PIECE(@VBMT@("VISTA IEN"),U,2)
+25 DO ^DIK
KILL DA,DIC,DIK
+26 SET VBX="VistA entry # "_DA_" was deleted."
+27 SET @VBMT@("VISTA UPDATE - ENTRY DELETED")=VBX
End DoDot:2
+28 IF '$DATA(@VBMT@("VISTA IEN"))
Begin DoDot:2
+29 SET VBX="No VistA update attempted because no IEN was retreived"
+30 SET @VBMT@("VISTA UPDATE - UPDATE NOT ATTEMPTED")=VBX
End DoDot:2
End DoDot:1
+31 ;
+32 IF $DATA(@VBMT@("VBECS ERROR TEXT"))
Begin DoDot:1
+33 IF $DATA(@VBMT@("VISTA IEN"))
Begin DoDot:2
+34 SET VBIEN=$PIECE(@VBMT@("VISTA IEN"),U,2)
+35 if VBIEN'?1.N
QUIT
+36 SET VBFDA(6002.01,VBIEN_",",5)="E"
+37 SET VBFDA(6002.01,VBIEN_",",20)=@VBMT@("VBECS ERROR TEXT")
+38 DO FILE^DIE("","VBFDA","VBERRMSG")
+39 IF '$DATA(VBERRMSG)
Begin DoDot:3
+40 SET VBX="Entry # "_VBIEN_" was updated"
+41 SET @VBMT@("VISTA UPDATE - ENTRY UPDATED")=VBX
End DoDot:3
+42 IF $DATA(VBERRMSG)
Begin DoDot:3
+43 SET VBFATAL=1
+44 SET VBX=$GET(VBERRMSG("DIERR",1,"TEXT",1))
+45 SET @VBMT@(" ERROR")="ERROR: "_VBX
+46 SET @VBMT@("VISTA UPDATE - UPDATE FAILED")=VBX
End DoDot:3
End DoDot:2
+47 IF '$DATA(@VBMT@("VISTA IEN"))
Begin DoDot:2
+48 SET VBFATAL=1
+49 SET VBX="No VistA update attempted (no IEN)"
+50 SET @VBMT@(" ERROR")="ERROR: "_VBX
+51 SET @VBMT@("VISTA UPDATE NOT ATTEMPTED")=VBX
End DoDot:2
End DoDot:1
+52 QUIT
+53 ;
CHAR(TEXT) ;
+1 if $DATA(@VBMT@(" ERROR"))
QUIT
+2 ;
+3 IF XML["ErrorText"
Begin DoDot:1
+4 SET @VBMT@("VBECS ERROR TEXT")="VBECS 'ErrorText' message: "_TEXT
End DoDot:1
+5 QUIT
+6 ;
