VBECA7A ;HOIFO/SAE - Workload API ; 9/30/04 5:38pm
;;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:
; VBECS workload update supported by IA 4628
; Reference to LIST^DIC supported by DBIA #2051
; Reference to EN^MXMLPRSE supported by IA #4149
;
QUIT
;
UPDTWKLD ; Update Workload Event Data
;
; This routine initializes Vistalink connection values (port,
; URL, etc.), then builds a local array of selected entries
; (those that have been successfully processed) from the
; VistA VBECS WORKLOAD CAPTURE (#6002.01) file.
; For each entry, listed in the local array, does the following:
; - sends request, via VistaLink, to .Net VBECS VistALink listener
; - receives response: VBECS processing status or ErrorText message
; - If no errors (comm, VistaLink, etc.):
; - update VBECS WORKLOAD CAPTURE (#6002.01) file entry:
; - delete it (if it had been successfully processed in VBECS) or
; - update two fields in this entry (if there had been ErrorText)
; - If comm, VistaLink, etc., errors:
; - not update VistA
; - save the non-specific error for inclusion in MailMan message.
; - A MailMan message is transmitted to the G.VBECS INTERFACE ADMIN
; mail group:
; - identifying success or failure and other transaction info
;
; Input - none
; Output - no output variables.
; However, MailMan msg is sent for fatal errors.
;
N VBY ; array of file 6002.01 fields from selected entries
N VBIEN ; IEN of entry to delete - used in ENELE subroutine
N VBRSLT ; ^TMP global array of results returned from VBECS
N VBMT ; array with VistA update status messages for mail text
N VBN ; loop control variable for For loop
N VBECPRMS ; local array for REQUEST and results
N VBIENSV ; IEN to save and use to verify same as VBECS
N VBMTBLT ; flag that signifies that VBMT has been built
;
S VBN=0
S VBRSLT=$NA(^TMP("VBECS_XML_RES",$J)) K @VBRSLT
S VBMT=$NA(^TMP("VBECS_MAIL_TEXT",$J)) K @VBMT
;
D INITV^VBECRPCC("VBECS Update Workload Event") ; init VL listener
D CHKERROR^VBECA7A1(.VBECPRMS,VBRSLT,VBMT)
I $D(@VBMT@(" ERROR")) D Q
. D BLDERMSG^VBECA7A1(.VBECPRMS,VBRSLT,VBMT)
. D SENDMSG(VBMT)
. D CLEANUP
;
D GETVISTA(.VBY)
;
; step thru array. each node contains one entry from file 6002.01
F S VBN=$O(VBY("DILIST",VBN)) Q:VBN']"" D Q:$D(@VBMT@(" ERROR"))
. K @VBMT
. D BLDPARMS(.VBY,VBN,.VBECPRMS)
. D BLDRSLTS(.VBECPRMS)
. D CHKERROR^VBECA7A1(.VBECPRMS,VBRSLT,VBMT)
. Q:$D(@VBMT@(" ERROR"))
. D BLDGLOB(.VBECPRMS,VBRSLT)
. D CHKERROR^VBECA7A1(.VBECPRMS,VBRSLT,VBMT)
. Q:$D(@VBMT@(" ERROR"))
. D SETVISTA(VBRSLT)
. D CHKERROR^VBECA7A1(.VBECPRMS,VBRSLT,VBMT)
;
I $D(@VBMT@(" ERROR")) D Q
. D BLDERMSG^VBECA7A1(.VBECPRMS,VBRSLT,VBMT)
. D SENDMSG(VBMT)
;
D CLEANUP
Q
;
GETVISTA(VBY) ; get file entries from VBECS WORKLOAD CAPTURE (#6002.01) file
;
Q:$D(@VBMT@(" ERROR"))
;
;
; Input
; none
; Output
; VBY - array, with each entries' fields packed into each node:
; IEN of entry is in first piece of the node value
; Fields shown in VBECFLDS variable
; List fields in same sequence as SDD Input section 4.1.4
;
N VBECFLDS ; fields to retrieve & pack in each VBY("DILIST") node
N VBECSCR ; screen to filter in entries for two fields:
; PROCESSED DATE (#4) field - not null
; STATUS (#5) field - (S)UCCESSFULLY PROCESSED
;
S X1=DT,X2=-14 D C^%DTC S VBOFF=X
S VBECFLDS="@;.01;5I;4I;20;99"
S VBECSCR("S")="I ($P(^(0),U,4)>VBOFF)&($P(^(0),U,6)=""S"")" ;RLM 6-1-2010
D LIST^DIC(6002.01,"",VBECFLDS,"P","","","","",.VBECSCR,"","VBY")
S VBLOOP=0 F S VBLOOP=$O(VBY("DILIST",VBLOOP)) Q:'VBLOOP S $P(VBY("DILIST",VBLOOP,0),"^",4)=$P(VBY("DILIST",VBLOOP,0),"^",4)_$E("0000000.000000",$L($P(VBY("DILIST",VBLOOP,0),"^",4)),13)
;Added formatting to ensure a six digit time. RLM 4/2/2008
; VBY("DILIST",4,0)=
; 8^AC934682-43C2-4B7E-B63B-063C7BABCFAD^^JUL 28, 2004@23:23:49^
; some sample error text^pce encounter value
Q
;
BLDPARMS(VBY,VBN,VBECPRMS) ; build VBECPRMS(PARAMS)
;
Q:$D(@VBMT@(" ERROR"))
;
; Build VBECPRMS("PARAMS" array for current VistA entry
;
; Input
; VBY ; Array: VBECS WORKLOAD CAPTURE (#6002.01) file entries
; VBN ; Node from VBY filtered collection of entries
; VBECPRMS ; root of target 'REQUEST' array to build
; Output
; VBECPRMS ; root of target 'REQUEST' array to build
;
N VBW ; field value
N VBECPI ; DILIST node piece and VBECPRMS node subscript
N VBNODVAL ; value of node
N VBX ; array node
;
S VBNODVAL=VBY("DILIST",VBN,0)
S VBX="INITIAL IEN: "_$P(VBNODVAL,U)_U_$P(VBNODVAL,U)
S @VBMT@("!INITIAL IEN")=VBX
S VBNODVAL=$E(VBNODVAL,$F(VBNODVAL,U),$L(VBNODVAL)) ; remove IEN
F VBECPI=1:1:5 D
. S VBW=$P(VBNODVAL,U,VBECPI)
. S VBECPRMS("PARAMS",VBECPI,"VALUE")=VBW
. S VBECPRMS("PARAMS",VBECPI,"TYPE")="STRING"
Q
;
BLDRSLTS(VBECPRMS) ; put results in VBECPRMS("RESULTS") local array
;
; Input
; VBECPRMS ; root of target 'REQUEST' array to build
; Output
; VBECPRMS ; root of target 'REQUEST' array to build
;
N VBSTAT ; temp variable
;
S VBSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
Q
;
BLDGLOB(VBECPRMS,VBRSLT) ; put results from VBECS in ^TMP global
;
Q:$D(@VBMT@(" ERROR"))
;
;
; Input
; VBECPRMS - array
; Output
; VBRSLT - $NA of ^TMP results global to build
;
D PARSE^VBECRPC1(.VBECPRMS,VBRSLT)
Q
;
SETVISTA(VBRSLT) ; Update Vista. MXMLPRSE invokes callback routines
;
; Input
; VBRSLT - name of results global
;
N VBCBK ; callback routines
;
Q:$D(@VBMT@(" ERROR"))
;
; callbacks allow MXMLPRSE to put data in file 6002.01
S VBCBK("STARTELEMENT")="STELE^VBECA7A1"
S VBCBK("ENDELEMENT")="ENELE^VBECA7A1"
S VBCBK("CHARACTERS")="CHAR^VBECA7A1"
S OPTION=""
D EN^MXMLPRSE(VBRSLT,.VBCBK,.OPTION)
Q
;
SENDMSG(VBMT) ; Function - send error message to mail group
;
; If unsuccessful deletion, send error text
;
; Input:
; VBMT array with info about transaction
;
N VBT ; node in array during $Q
N VBLN ; message parameters
N VBGROUP ; name of mail group to which message will be sent
N VBCNT ; line count of VBLN array
N VBUSERNM ; IEN of user's entry in NEW PERSON file
N VBUSER ; name of user running this program
N XMDUZ ; sender
N XMSUB ; message subject
N XMTEXT ; message text array
N XMY ; recipient array
N XMZ ; returned message number
;
I '$D(@VBMT@(" ERROR")) Q
;. S VBX="SUCCESSFUL VBECS-VistA dialog"
;. S @VBMT@("!SUCCESSFUL VBECS-VISTA DIALOG")=VBX
;
S VBCNT=1
S VBT=$NA(@VBMT)
;
;S VBUSERNM=$$GET1^DIQ(200,DUZ,.01)
;
S VBLN(VBCNT)="* * * VBECS Workload Event Error Notification * * *"
F S VBT=$Q(@VBT) Q:VBT="" Q:$NA(@VBT)'[$J D
. S VBCNT=VBCNT+1
. S:VBT["DILIST" VBLN(VBCNT)=$G(@VBT)
. S:VBT'["DILIST" VBLN(VBCNT)=$P($G(@VBT),U)
. S VBLN(VBCNT)=$TR(VBLN(VBCNT),"""","'")
;
S XMDUZ="VBECS Workload Event"
S XMSUB="VBECS Workload Event"
S XMTEXT="VBLN("
; reactivate the following ling after testing:
S XMY("G.VBECS INTERFACE ADMIN")=""
;S XMY(VBUSERNM)=""
D ^XMD
Q
;
CLEANUP K ATR,CBK,DIERR,ELE,VBFDA,OPTION,TEXT,VBECPRMS,@VBRSLT,@VBMT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECA7A 7637 printed Sep 23, 2025@20:20 Page 2
VBECA7A ;HOIFO/SAE - Workload API ; 9/30/04 5:38pm
+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 ; VBECS workload update supported by IA 4628
+9 ; Reference to LIST^DIC supported by DBIA #2051
+10 ; Reference to EN^MXMLPRSE supported by IA #4149
+11 ;
+12 QUIT
+13 ;
UPDTWKLD ; Update Workload Event Data
+1 ;
+2 ; This routine initializes Vistalink connection values (port,
+3 ; URL, etc.), then builds a local array of selected entries
+4 ; (those that have been successfully processed) from the
+5 ; VistA VBECS WORKLOAD CAPTURE (#6002.01) file.
+6 ; For each entry, listed in the local array, does the following:
+7 ; - sends request, via VistaLink, to .Net VBECS VistALink listener
+8 ; - receives response: VBECS processing status or ErrorText message
+9 ; - If no errors (comm, VistaLink, etc.):
+10 ; - update VBECS WORKLOAD CAPTURE (#6002.01) file entry:
+11 ; - delete it (if it had been successfully processed in VBECS) or
+12 ; - update two fields in this entry (if there had been ErrorText)
+13 ; - If comm, VistaLink, etc., errors:
+14 ; - not update VistA
+15 ; - save the non-specific error for inclusion in MailMan message.
+16 ; - A MailMan message is transmitted to the G.VBECS INTERFACE ADMIN
+17 ; mail group:
+18 ; - identifying success or failure and other transaction info
+19 ;
+20 ; Input - none
+21 ; Output - no output variables.
+22 ; However, MailMan msg is sent for fatal errors.
+23 ;
+24 ; array of file 6002.01 fields from selected entries
NEW VBY
+25 ; IEN of entry to delete - used in ENELE subroutine
NEW VBIEN
+26 ; ^TMP global array of results returned from VBECS
NEW VBRSLT
+27 ; array with VistA update status messages for mail text
NEW VBMT
+28 ; loop control variable for For loop
NEW VBN
+29 ; local array for REQUEST and results
NEW VBECPRMS
+30 ; IEN to save and use to verify same as VBECS
NEW VBIENSV
+31 ; flag that signifies that VBMT has been built
NEW VBMTBLT
+32 ;
+33 SET VBN=0
+34 SET VBRSLT=$NAME(^TMP("VBECS_XML_RES",$JOB))
KILL @VBRSLT
+35 SET VBMT=$NAME(^TMP("VBECS_MAIL_TEXT",$JOB))
KILL @VBMT
+36 ;
+37 ; init VL listener
DO INITV^VBECRPCC("VBECS Update Workload Event")
+38 DO CHKERROR^VBECA7A1(.VBECPRMS,VBRSLT,VBMT)
+39 IF $DATA(@VBMT@(" ERROR"))
Begin DoDot:1
+40 DO BLDERMSG^VBECA7A1(.VBECPRMS,VBRSLT,VBMT)
+41 DO SENDMSG(VBMT)
+42 DO CLEANUP
End DoDot:1
QUIT
+43 ;
+44 DO GETVISTA(.VBY)
+45 ;
+46 ; step thru array. each node contains one entry from file 6002.01
+47 FOR
SET VBN=$ORDER(VBY("DILIST",VBN))
if VBN']""
QUIT
Begin DoDot:1
+48 KILL @VBMT
+49 DO BLDPARMS(.VBY,VBN,.VBECPRMS)
+50 DO BLDRSLTS(.VBECPRMS)
+51 DO CHKERROR^VBECA7A1(.VBECPRMS,VBRSLT,VBMT)
+52 if $DATA(@VBMT@(" ERROR"))
QUIT
+53 DO BLDGLOB(.VBECPRMS,VBRSLT)
+54 DO CHKERROR^VBECA7A1(.VBECPRMS,VBRSLT,VBMT)
+55 if $DATA(@VBMT@(" ERROR"))
QUIT
+56 DO SETVISTA(VBRSLT)
+57 DO CHKERROR^VBECA7A1(.VBECPRMS,VBRSLT,VBMT)
End DoDot:1
if $DATA(@VBMT@(" ERROR"))
QUIT
+58 ;
+59 IF $DATA(@VBMT@(" ERROR"))
Begin DoDot:1
+60 DO BLDERMSG^VBECA7A1(.VBECPRMS,VBRSLT,VBMT)
+61 DO SENDMSG(VBMT)
End DoDot:1
QUIT
+62 ;
+63 DO CLEANUP
+64 QUIT
+65 ;
GETVISTA(VBY) ; get file entries from VBECS WORKLOAD CAPTURE (#6002.01) file
+1 ;
+2 if $DATA(@VBMT@(" ERROR"))
QUIT
+3 ;
+4 ;
+5 ; Input
+6 ; none
+7 ; Output
+8 ; VBY - array, with each entries' fields packed into each node:
+9 ; IEN of entry is in first piece of the node value
+10 ; Fields shown in VBECFLDS variable
+11 ; List fields in same sequence as SDD Input section 4.1.4
+12 ;
+13 ; fields to retrieve & pack in each VBY("DILIST") node
NEW VBECFLDS
+14 ; screen to filter in entries for two fields:
NEW VBECSCR
+15 ; PROCESSED DATE (#4) field - not null
+16 ; STATUS (#5) field - (S)UCCESSFULLY PROCESSED
+17 ;
+18 SET X1=DT
SET X2=-14
DO C^%DTC
SET VBOFF=X
+19 SET VBECFLDS="@;.01;5I;4I;20;99"
+20 ;RLM 6-1-2010
SET VBECSCR("S")="I ($P(^(0),U,4)>VBOFF)&($P(^(0),U,6)=""S"")"
+21 DO LIST^DIC(6002.01,"",VBECFLDS,"P","","","","",.VBECSCR,"","VBY")
+22 SET VBLOOP=0
FOR
SET VBLOOP=$ORDER(VBY("DILIST",VBLOOP))
if 'VBLOOP
QUIT
SET $PIECE(VBY("DILIST",VBLOOP,0),"^",4)=$PIECE(VBY("DILIST",VBLOOP,0),"^",4)_$EXTRACT("0000000.000000",$LENGTH($PIECE(VBY("DILIST",VBLOOP,0),"^",4)),13)
+23 ;Added formatting to ensure a six digit time. RLM 4/2/2008
+24 ; VBY("DILIST",4,0)=
+25 ; 8^AC934682-43C2-4B7E-B63B-063C7BABCFAD^^JUL 28, 2004@23:23:49^
+26 ; some sample error text^pce encounter value
+27 QUIT
+28 ;
BLDPARMS(VBY,VBN,VBECPRMS) ; build VBECPRMS(PARAMS)
+1 ;
+2 if $DATA(@VBMT@(" ERROR"))
QUIT
+3 ;
+4 ; Build VBECPRMS("PARAMS" array for current VistA entry
+5 ;
+6 ; Input
+7 ; VBY ; Array: VBECS WORKLOAD CAPTURE (#6002.01) file entries
+8 ; VBN ; Node from VBY filtered collection of entries
+9 ; VBECPRMS ; root of target 'REQUEST' array to build
+10 ; Output
+11 ; VBECPRMS ; root of target 'REQUEST' array to build
+12 ;
+13 ; field value
NEW VBW
+14 ; DILIST node piece and VBECPRMS node subscript
NEW VBECPI
+15 ; value of node
NEW VBNODVAL
+16 ; array node
NEW VBX
+17 ;
+18 SET VBNODVAL=VBY("DILIST",VBN,0)
+19 SET VBX="INITIAL IEN: "_$PIECE(VBNODVAL,U)_U_$PIECE(VBNODVAL,U)
+20 SET @VBMT@("!INITIAL IEN")=VBX
+21 ; remove IEN
SET VBNODVAL=$EXTRACT(VBNODVAL,$FIND(VBNODVAL,U),$LENGTH(VBNODVAL))
+22 FOR VBECPI=1:1:5
Begin DoDot:1
+23 SET VBW=$PIECE(VBNODVAL,U,VBECPI)
+24 SET VBECPRMS("PARAMS",VBECPI,"VALUE")=VBW
+25 SET VBECPRMS("PARAMS",VBECPI,"TYPE")="STRING"
End DoDot:1
+26 QUIT
+27 ;
BLDRSLTS(VBECPRMS) ; put results in VBECPRMS("RESULTS") local array
+1 ;
+2 ; Input
+3 ; VBECPRMS ; root of target 'REQUEST' array to build
+4 ; Output
+5 ; VBECPRMS ; root of target 'REQUEST' array to build
+6 ;
+7 ; temp variable
NEW VBSTAT
+8 ;
+9 SET VBSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
+10 QUIT
+11 ;
BLDGLOB(VBECPRMS,VBRSLT) ; put results from VBECS in ^TMP global
+1 ;
+2 if $DATA(@VBMT@(" ERROR"))
QUIT
+3 ;
+4 ;
+5 ; Input
+6 ; VBECPRMS - array
+7 ; Output
+8 ; VBRSLT - $NA of ^TMP results global to build
+9 ;
+10 DO PARSE^VBECRPC1(.VBECPRMS,VBRSLT)
+11 QUIT
+12 ;
SETVISTA(VBRSLT) ; Update Vista. MXMLPRSE invokes callback routines
+1 ;
+2 ; Input
+3 ; VBRSLT - name of results global
+4 ;
+5 ; callback routines
NEW VBCBK
+6 ;
+7 if $DATA(@VBMT@(" ERROR"))
QUIT
+8 ;
+9 ; callbacks allow MXMLPRSE to put data in file 6002.01
+10 SET VBCBK("STARTELEMENT")="STELE^VBECA7A1"
+11 SET VBCBK("ENDELEMENT")="ENELE^VBECA7A1"
+12 SET VBCBK("CHARACTERS")="CHAR^VBECA7A1"
+13 SET OPTION=""
+14 DO EN^MXMLPRSE(VBRSLT,.VBCBK,.OPTION)
+15 QUIT
+16 ;
SENDMSG(VBMT) ; Function - send error message to mail group
+1 ;
+2 ; If unsuccessful deletion, send error text
+3 ;
+4 ; Input:
+5 ; VBMT array with info about transaction
+6 ;
+7 ; node in array during $Q
NEW VBT
+8 ; message parameters
NEW VBLN
+9 ; name of mail group to which message will be sent
NEW VBGROUP
+10 ; line count of VBLN array
NEW VBCNT
+11 ; IEN of user's entry in NEW PERSON file
NEW VBUSERNM
+12 ; name of user running this program
NEW VBUSER
+13 ; sender
NEW XMDUZ
+14 ; message subject
NEW XMSUB
+15 ; message text array
NEW XMTEXT
+16 ; recipient array
NEW XMY
+17 ; returned message number
NEW XMZ
+18 ;
+19 IF '$DATA(@VBMT@(" ERROR"))
QUIT
+20 ;. S VBX="SUCCESSFUL VBECS-VistA dialog"
+21 ;. S @VBMT@("!SUCCESSFUL VBECS-VISTA DIALOG")=VBX
+22 ;
+23 SET VBCNT=1
+24 SET VBT=$NAME(@VBMT)
+25 ;
+26 ;S VBUSERNM=$$GET1^DIQ(200,DUZ,.01)
+27 ;
+28 SET VBLN(VBCNT)="* * * VBECS Workload Event Error Notification * * *"
+29 FOR
SET VBT=$QUERY(@VBT)
if VBT=""
QUIT
if $NAME(@VBT)'[$JOB
QUIT
Begin DoDot:1
+30 SET VBCNT=VBCNT+1
+31 if VBT["DILIST"
SET VBLN(VBCNT)=$GET(@VBT)
+32 if VBT'["DILIST"
SET VBLN(VBCNT)=$PIECE($GET(@VBT),U)
+33 SET VBLN(VBCNT)=$TRANSLATE(VBLN(VBCNT),"""","'")
End DoDot:1
+34 ;
+35 SET XMDUZ="VBECS Workload Event"
+36 SET XMSUB="VBECS Workload Event"
+37 SET XMTEXT="VBLN("
+38 ; reactivate the following ling after testing:
+39 SET XMY("G.VBECS INTERFACE ADMIN")=""
+40 ;S XMY(VBUSERNM)=""
+41 DO ^XMD
+42 QUIT
+43 ;
CLEANUP KILL ATR,CBK,DIERR,ELE,VBFDA,OPTION,TEXT,VBECPRMS,@VBRSLT,@VBMT
+1 QUIT
