HDISVM00 ;BPFO/JRP - SERVER TO RECEIVE XML MESSAGE;1/4/2005
;;1.0;HEALTH DATA & INFORMATICS;**6,7**;Feb 22, 2005;Build 33
;
XML ;Main entry point for XML server options
; Input: (As defined by MailMan and Kernel)
; XMREC - Executable code to "read" next line of message
; XQSUB - Subject of received message
; XQSOP - Server option name
; XQMSG,XMZ - Msg IEN in file 3.9
; XQSND,XMFROM - Msg sender
;Output: None
; Note: Input is not checked (assumes existence)
;
NEW XMLARR,PRSARR,ERRARR,STOP,LINE,TYPE
;Establish temporary globals
SET XMLARR=$NAME(^TMP(XQSOP,$JOB,"XML"))
SET PRSARR=$NAME(^TMP(XQSOP,$JOB,"PARSED"))
SET ERRARR=$NAME(^TMP(XQSOP,$JOB,"ERROR"))
KILL @XMLARR,@PRSARR,@ERRARR
;Copy message to temporary global
SET STOP=0
FOR LINE=1:1 DO QUIT:STOP
.XECUTE XMREC
.IF $DATA(XMER) IF (XMER<0) SET STOP=1 QUIT
.SET @XMLARR@(LINE)=XMRG
;Parse message
DO SAX^HDISVM01(XMLARR,PRSARR)
;Get type of system out of parameter file
SET TYPE=+$$GETTYPE^HDISVF02()
;Process messages on centralized server
IF TYPE=2 DO MAIN^HDISVS00(PRSARR,ERRARR)
;Process messages on VistA (client) system
IF TYPE=1 DO MAIN^HDISVC00(PRSARR,ERRARR)
;Error(s) occurred
IF $DATA(@ERRARR) DO
.;Send error message
.DO ERROR(ERRARR,XQMSG,XQSOP,XMFROM)
.;Set message status
.SET X=$$SRVTIME^XMS1(XQMSG,"S."_XQSOP,"ERROR FOUND DURING PROCESSING")
;Delete message (don't delete if errors found)
IF '$DATA(@ERRARR) DO ZAPSERV^XMXAPI("S."_XQSOP,XQMSG)
;Done
KILL @XMLARR,@PRSARR,@ERRARR
QUIT
;
ERROR(ERRARR,MSGNUM,SRVR,SNDR) ;Send error message
; Input : ERRARR - Error array (closed root)
; MSGNUM - Message number of received message (XMZ)
; SRVR - Name of server option (XQSOP)
; SNDR - Sender of message (XMFROM)
;Output : None
; Notes : Existance/validity of input assumed (internal call)
NEW NAME,HDISPRAM,HDISFLAG
;Set bulletin parameters
SET HDISPRAM(1)=MSGNUM
SET HDISPRAM(2)=SNDR
SET HDISPRAM(3)=SRVR
;Send bulletin
SET NAME="HDIS XML MSG PROCESS ERROR"
SET HDISFLAG("FROM")="HDIS XML MESSAGE SERVER"
;TASKBULL^XMXAPI was redefining ERRARR when it ran so switched to SENDBULL
DO SENDBULL^XMXAPI(DUZ,NAME,.HDISPRAM,ERRARR,,.HDISFLAG)
IF $GET(XMERR) DO
.;Error generating bulletin - log error text
.DO ERR2XTMP^HDISVU01("HDI-XM","Server error bulletin",$NAME(^TMP("XMERR",$JOB)))
.KILL XMERR,^TMP("XMERR",$JOB)
QUIT
;
LABXCPT ;Main entry point for serving UUEncoded Lab exception messages
; Input: (As defined by MailMan and Kernel)
; XMREC - Executable code to "read" next line of message
; XQSUB - Subject of received message
; XQSOP - Server option name
; XQMSG,XMZ - Msg IEN in file 3.9
; XQSND,XMFROM - Msg sender
;Output: None
; Note: Input is not checked (assumes existence)
;
NEW STOP,LINE,MSGARR,ERRARR
SET MSGARR=$NAME(^TMP("HDISVM00",$JOB,"MSGARR"))
SET ERRARR=$NAME(^TMP("HDISVM00",$JOB,"ERRARR"))
KILL @MSGARR,@ERRARR
;Copy message to temporary global
SET STOP=0
FOR LINE=1:1 DO QUIT:(STOP)
.XECUTE XMREC
.IF ($DATA(XMER)) IF (XMER<0) SET STOP=1 QUIT
.SET @MSGARR@(LINE,0)=XMRG
.QUIT
;Get type of system out of parameter file
SET TYPE=+$$GETTYPE^HDISVF02()
;Process messages on centralized server
IF TYPE=2 DO LABXCPT^HDISVS04(MSGARR,ERRARR)
;Send error message
IF ($DATA(@ERRARR)) DO
.DO ERROR(ERRARR,XQMSG,XQSOP,XMFROM)
.;Set message status
.SET X=$$SRVTIME^XMS1(XQMSG,"S."_XQSOP,"ERROR FOUND DURING PROCESSING")
;Delete message (don't delete if errors found)
IF ('$DATA(@ERRARR)) DO ZAPSERV^XMXAPI("S."_XQSOP,XQMSG)
;Done
KILL @MSGARR,@ERRARR
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISVM00 3743 printed Sep 23, 2025@19:33:01 Page 2
HDISVM00 ;BPFO/JRP - SERVER TO RECEIVE XML MESSAGE;1/4/2005
+1 ;;1.0;HEALTH DATA & INFORMATICS;**6,7**;Feb 22, 2005;Build 33
+2 ;
XML ;Main entry point for XML server options
+1 ; Input: (As defined by MailMan and Kernel)
+2 ; XMREC - Executable code to "read" next line of message
+3 ; XQSUB - Subject of received message
+4 ; XQSOP - Server option name
+5 ; XQMSG,XMZ - Msg IEN in file 3.9
+6 ; XQSND,XMFROM - Msg sender
+7 ;Output: None
+8 ; Note: Input is not checked (assumes existence)
+9 ;
+10 NEW XMLARR,PRSARR,ERRARR,STOP,LINE,TYPE
+11 ;Establish temporary globals
+12 SET XMLARR=$NAME(^TMP(XQSOP,$JOB,"XML"))
+13 SET PRSARR=$NAME(^TMP(XQSOP,$JOB,"PARSED"))
+14 SET ERRARR=$NAME(^TMP(XQSOP,$JOB,"ERROR"))
+15 KILL @XMLARR,@PRSARR,@ERRARR
+16 ;Copy message to temporary global
+17 SET STOP=0
+18 FOR LINE=1:1
Begin DoDot:1
+19 XECUTE XMREC
+20 IF $DATA(XMER)
IF (XMER<0)
SET STOP=1
QUIT
+21 SET @XMLARR@(LINE)=XMRG
End DoDot:1
if STOP
QUIT
+22 ;Parse message
+23 DO SAX^HDISVM01(XMLARR,PRSARR)
+24 ;Get type of system out of parameter file
+25 SET TYPE=+$$GETTYPE^HDISVF02()
+26 ;Process messages on centralized server
+27 IF TYPE=2
DO MAIN^HDISVS00(PRSARR,ERRARR)
+28 ;Process messages on VistA (client) system
+29 IF TYPE=1
DO MAIN^HDISVC00(PRSARR,ERRARR)
+30 ;Error(s) occurred
+31 IF $DATA(@ERRARR)
Begin DoDot:1
+32 ;Send error message
+33 DO ERROR(ERRARR,XQMSG,XQSOP,XMFROM)
+34 ;Set message status
+35 SET X=$$SRVTIME^XMS1(XQMSG,"S."_XQSOP,"ERROR FOUND DURING PROCESSING")
End DoDot:1
+36 ;Delete message (don't delete if errors found)
+37 IF '$DATA(@ERRARR)
DO ZAPSERV^XMXAPI("S."_XQSOP,XQMSG)
+38 ;Done
+39 KILL @XMLARR,@PRSARR,@ERRARR
+40 QUIT
+41 ;
ERROR(ERRARR,MSGNUM,SRVR,SNDR) ;Send error message
+1 ; Input : ERRARR - Error array (closed root)
+2 ; MSGNUM - Message number of received message (XMZ)
+3 ; SRVR - Name of server option (XQSOP)
+4 ; SNDR - Sender of message (XMFROM)
+5 ;Output : None
+6 ; Notes : Existance/validity of input assumed (internal call)
+7 NEW NAME,HDISPRAM,HDISFLAG
+8 ;Set bulletin parameters
+9 SET HDISPRAM(1)=MSGNUM
+10 SET HDISPRAM(2)=SNDR
+11 SET HDISPRAM(3)=SRVR
+12 ;Send bulletin
+13 SET NAME="HDIS XML MSG PROCESS ERROR"
+14 SET HDISFLAG("FROM")="HDIS XML MESSAGE SERVER"
+15 ;TASKBULL^XMXAPI was redefining ERRARR when it ran so switched to SENDBULL
+16 DO SENDBULL^XMXAPI(DUZ,NAME,.HDISPRAM,ERRARR,,.HDISFLAG)
+17 IF $GET(XMERR)
Begin DoDot:1
+18 ;Error generating bulletin - log error text
+19 DO ERR2XTMP^HDISVU01("HDI-XM","Server error bulletin",$NAME(^TMP("XMERR",$JOB)))
+20 KILL XMERR,^TMP("XMERR",$JOB)
End DoDot:1
+21 QUIT
+22 ;
LABXCPT ;Main entry point for serving UUEncoded Lab exception messages
+1 ; Input: (As defined by MailMan and Kernel)
+2 ; XMREC - Executable code to "read" next line of message
+3 ; XQSUB - Subject of received message
+4 ; XQSOP - Server option name
+5 ; XQMSG,XMZ - Msg IEN in file 3.9
+6 ; XQSND,XMFROM - Msg sender
+7 ;Output: None
+8 ; Note: Input is not checked (assumes existence)
+9 ;
+10 NEW STOP,LINE,MSGARR,ERRARR
+11 SET MSGARR=$NAME(^TMP("HDISVM00",$JOB,"MSGARR"))
+12 SET ERRARR=$NAME(^TMP("HDISVM00",$JOB,"ERRARR"))
+13 KILL @MSGARR,@ERRARR
+14 ;Copy message to temporary global
+15 SET STOP=0
+16 FOR LINE=1:1
Begin DoDot:1
+17 XECUTE XMREC
+18 IF ($DATA(XMER))
IF (XMER<0)
SET STOP=1
QUIT
+19 SET @MSGARR@(LINE,0)=XMRG
+20 QUIT
End DoDot:1
if (STOP)
QUIT
+21 ;Get type of system out of parameter file
+22 SET TYPE=+$$GETTYPE^HDISVF02()
+23 ;Process messages on centralized server
+24 IF TYPE=2
DO LABXCPT^HDISVS04(MSGARR,ERRARR)
+25 ;Send error message
+26 IF ($DATA(@ERRARR))
Begin DoDot:1
+27 DO ERROR(ERRARR,XQMSG,XQSOP,XMFROM)
+28 ;Set message status
+29 SET X=$$SRVTIME^XMS1(XQMSG,"S."_XQSOP,"ERROR FOUND DURING PROCESSING")
End DoDot:1
+30 ;Delete message (don't delete if errors found)
+31 IF ('$DATA(@ERRARR))
DO ZAPSERV^XMXAPI("S."_XQSOP,XQMSG)
+32 ;Done
+33 KILL @MSGARR,@ERRARR
+34 QUIT
