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