HDISVM02 ;;CT/GRR SEND MESSAGE ; 02 Mar 2005 4:25 PM
;;1.0;HEALTH DATA & INFORMATICS;**6**;Feb 22, 2005
;
SNDXML(ARRY,SRVR,HDISINP,SYSPTR) ;Send XML document to server
; Input: ARRY - Array containing XML document (closed root)
; SRVR - 1 = VUID Server, 2 = Status Update Server
; HDISINP - Array containing additional info (closed root) (optional)
; @HDISINP@(variable) = Value
; @HDISINP@(array,subscript) = Value
; @HDISINP@(array,subscript_1,subscript_2,...) = Value
;
; Example:
; @HDISINP@("TEST1")=1
; @HDISINP@("TEST2")=2
; @HDISINP@("TEST2","SUB1")="2A"
; @HDISINP@("TEST3","SUB1","SUB2")="3B"
;
; Results in the following variables/arrays being set:
; TEST1=1
; TEST2=2
; TEST2("SUB1")="2A"
; TEST3("SUB1","SUB2")="3B"
; SYSPTR - Pointer to HDIS System file (optional)
; If passed, the destination information is obtained
; from the HDIS Parameter file entry for the referenced
; system. By default, the destination information is
; pulled from the HDIS Parameter entry for the current
; system (which contains the destination information for
; the centrally located server)
;Output: None
; XML document sent to Data Standardization server option
; at given MailMan domain
;
I ARRY=""!(SRVR="") Q "0^Required parameter missing"
I SRVR'=1&(SRVR'=2) Q "0^SRVR Parameter invalid"
N SUBJECT,HDITO,HDINSTR,HDIXMZ,SERVER,SRVTYP,MAXLIN,SRVROPT
S SYSPTR=+$G(SYSPTR)
I 'SYSPTR K SYSPTR I '$$CURSYS^HDISVF07(.SYSPTR) Q "0^Unable to determine current system"
;Get location information for VUID Server
I SRVR=1 D
.S SERVER=$$GETVLOC^HDISVF02(SYSPTR)
.S SRVTYP=$$GETVCON^HDISVF02(SYSPTR)
.S SRVROPT=$$GETVSRV^HDISVF02(SYSPTR)
;Get location information for Status Server
I SRVR=2 D
.S SERVER=$$GETSLOC^HDISVF03(SYSPTR)
.S SRVTYP=$$GETSCON^HDISVF03(SYSPTR)
.S SRVROPT=$$GETSSRV^HDISVF03(SYSPTR)
;Instantiate variables included in input array
I $G(HDISINP)]"" D
.N ROOT,RSCNT,NODE,NSCNT,TROOT
.S ROOT=$$OREF^DILF(HDISINP)
.S RSCNT=$QL(HDISINP)
.S NODE=HDISINP
.F S NODE=$Q(@NODE) Q:(NODE="")!(NODE'[ROOT) I $D(@NODE)#2 D
..S NSCNT=$QL(NODE)
..I (NSCNT-RSCNT)=1 S @$QS(NODE,NSCNT)=$G(@NODE) Q
..S TROOT=$QS(NODE,RSCNT+1)_"("_$P(NODE,",",RSCNT+2,NSCNT)
..S @TROOT=$G(@NODE)
;Set message subject
I $G(SUBJECT)="" S SUBJECT="XML FORMATTED DATA FROM "_$P($$SITE^VASITE(),"^",2)
;Set message sender
S HDINSTR("FROM")="Data Standardization Toolset"
;Set recipient list (includes server option on target server)
N HDITO
I SERVER="" S HDITO("S."_SRVROPT)=""
I SERVER'="" S HDITO("S."_SRVROPT_"@"_SERVER)=""
;Send message to target server
D SENDMSG^XMXAPI(DUZ,SUBJECT,ARRY,.HDITO,.HDINSTR,.HDIXMZ)
I $G(XMERR) D
.;Error sending message - log error text
.D ERR2XTMP^HDISVU01("HDI-XM","Message sending",$NA(^TMP("XMERR",$J)))
.K XMERR,^TMP("XMERR",$J)
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISVM02 3296 printed Jan 18, 2025@02:58:09 Page 2
HDISVM02 ;;CT/GRR SEND MESSAGE ; 02 Mar 2005 4:25 PM
+1 ;;1.0;HEALTH DATA & INFORMATICS;**6**;Feb 22, 2005
+2 ;
SNDXML(ARRY,SRVR,HDISINP,SYSPTR) ;Send XML document to server
+1 ; Input: ARRY - Array containing XML document (closed root)
+2 ; SRVR - 1 = VUID Server, 2 = Status Update Server
+3 ; HDISINP - Array containing additional info (closed root) (optional)
+4 ; @HDISINP@(variable) = Value
+5 ; @HDISINP@(array,subscript) = Value
+6 ; @HDISINP@(array,subscript_1,subscript_2,...) = Value
+7 ;
+8 ; Example:
+9 ; @HDISINP@("TEST1")=1
+10 ; @HDISINP@("TEST2")=2
+11 ; @HDISINP@("TEST2","SUB1")="2A"
+12 ; @HDISINP@("TEST3","SUB1","SUB2")="3B"
+13 ;
+14 ; Results in the following variables/arrays being set:
+15 ; TEST1=1
+16 ; TEST2=2
+17 ; TEST2("SUB1")="2A"
+18 ; TEST3("SUB1","SUB2")="3B"
+19 ; SYSPTR - Pointer to HDIS System file (optional)
+20 ; If passed, the destination information is obtained
+21 ; from the HDIS Parameter file entry for the referenced
+22 ; system. By default, the destination information is
+23 ; pulled from the HDIS Parameter entry for the current
+24 ; system (which contains the destination information for
+25 ; the centrally located server)
+26 ;Output: None
+27 ; XML document sent to Data Standardization server option
+28 ; at given MailMan domain
+29 ;
+30 IF ARRY=""!(SRVR="")
QUIT "0^Required parameter missing"
+31 IF SRVR'=1&(SRVR'=2)
QUIT "0^SRVR Parameter invalid"
+32 NEW SUBJECT,HDITO,HDINSTR,HDIXMZ,SERVER,SRVTYP,MAXLIN,SRVROPT
+33 SET SYSPTR=+$GET(SYSPTR)
+34 IF 'SYSPTR
KILL SYSPTR
IF '$$CURSYS^HDISVF07(.SYSPTR)
QUIT "0^Unable to determine current system"
+35 ;Get location information for VUID Server
+36 IF SRVR=1
Begin DoDot:1
+37 SET SERVER=$$GETVLOC^HDISVF02(SYSPTR)
+38 SET SRVTYP=$$GETVCON^HDISVF02(SYSPTR)
+39 SET SRVROPT=$$GETVSRV^HDISVF02(SYSPTR)
End DoDot:1
+40 ;Get location information for Status Server
+41 IF SRVR=2
Begin DoDot:1
+42 SET SERVER=$$GETSLOC^HDISVF03(SYSPTR)
+43 SET SRVTYP=$$GETSCON^HDISVF03(SYSPTR)
+44 SET SRVROPT=$$GETSSRV^HDISVF03(SYSPTR)
End DoDot:1
+45 ;Instantiate variables included in input array
+46 IF $GET(HDISINP)]""
Begin DoDot:1
+47 NEW ROOT,RSCNT,NODE,NSCNT,TROOT
+48 SET ROOT=$$OREF^DILF(HDISINP)
+49 SET RSCNT=$QLENGTH(HDISINP)
+50 SET NODE=HDISINP
+51 FOR
SET NODE=$QUERY(@NODE)
if (NODE="")!(NODE'[ROOT)
QUIT
IF $DATA(@NODE)#2
Begin DoDot:2
+52 SET NSCNT=$QLENGTH(NODE)
+53 IF (NSCNT-RSCNT)=1
SET @$QSUBSCRIPT(NODE,NSCNT)=$GET(@NODE)
QUIT
+54 SET TROOT=$QSUBSCRIPT(NODE,RSCNT+1)_"("_$PIECE(NODE,",",RSCNT+2,NSCNT)
+55 SET @TROOT=$GET(@NODE)
End DoDot:2
End DoDot:1
+56 ;Set message subject
+57 IF $GET(SUBJECT)=""
SET SUBJECT="XML FORMATTED DATA FROM "_$PIECE($$SITE^VASITE(),"^",2)
+58 ;Set message sender
+59 SET HDINSTR("FROM")="Data Standardization Toolset"
+60 ;Set recipient list (includes server option on target server)
+61 NEW HDITO
+62 IF SERVER=""
SET HDITO("S."_SRVROPT)=""
+63 IF SERVER'=""
SET HDITO("S."_SRVROPT_"@"_SERVER)=""
+64 ;Send message to target server
+65 DO SENDMSG^XMXAPI(DUZ,SUBJECT,ARRY,.HDITO,.HDINSTR,.HDIXMZ)
+66 IF $GET(XMERR)
Begin DoDot:1
+67 ;Error sending message - log error text
+68 DO ERR2XTMP^HDISVU01("HDI-XM","Message sending",$NAME(^TMP("XMERR",$JOB)))
+69 KILL XMERR,^TMP("XMERR",$JOB)
End DoDot:1
+70 QUIT 1
+71 ;
