HDISVM00.m

HDISVM00 ;BPFO/JRP - SERVER TO RECEIVE XML MESSAGE;1/4/2005

 ;;1.0;HEALTH DATA & INFORMATICS;**6**;Feb 22, 2005

 ;

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)

 ;

 N XMLARR,PRSARR,ERRARR,STOP,LINE,TYPE

 ;Establish temporary globals

 S XMLARR=$NA(^TMP(XQSOP,$J,"XML"))

 S PRSARR=$NA(^TMP(XQSOP,$J,"PARSED"))

 S ERRARR=$NA(^TMP(XQSOP,$J,"ERROR"))

 K @XMLARR,@PRSARR,@ERRARR

 ;Copy message to temporary global

 S STOP=0

 F LINE=1:1 D  Q:STOP

 .X XMREC

 .I $D(XMER) I (XMER<0) S STOP=1 Q

 .S @XMLARR@(LINE)=XMRG

 ;Parse message

 D SAX^HDISVM01(XMLARR,PRSARR)

 ;Get type of system out of parameter file

 S TYPE=+$$GETTYPE^HDISVF02()

 ;Process messages on centralized server

 I TYPE=2 D MAIN^HDISVS00(PRSARR,ERRARR)

 ;Process messages on VistA (client) system

 I TYPE=1 D MAIN^HDISVC00(PRSARR,ERRARR)

 ;Error(s) occurred

 I $D(@ERRARR) D

 .;Send error message

 .D ERROR(ERRARR,XQMSG,XQSOP,XMFROM)

 .;Set message status

 .S X=$$SRVTIME^XMS1(XQMSG,"S."_XQSOP,"ERROR FOUND DURING PROCESSING")

 ;Delete message (don't delete if errors found)

 I '$D(@ERRARR) D ZAPSERV^XMXAPI("S."_XQSOP,XQMSG)

 ;Done

 K @XMLARR,@PRSARR,@ERRARR

 Q

 ;

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)

 N NAME,HDISPRAM,HDISFLAG,HDISTASK

 ;Set bulletin parameters

 S HDISPRAM(1)=MSGNUM

 S HDISPRAM(2)=SNDR

 S HDISPRAM(3)=SRVR

 ;Send bulletin

 S NAME="HDIS XML MSG PROCESS ERROR"

 S HDISFLAG("FROM")="HDIS XML MESSAGE SERVER"

 D TASKBULL^XMXAPI(DUZ,NAME,.HDISPRAM,ERRARR,,.HDISFLAG,.HDISTASK)

 I $G(XMERR) D

 .;Error generating bulletin - log error text

 .D ERR2XTMP^HDISVU01("HDI-XM","Server error bulletin",$NA(^TMP("XMERR",$J)))

 .K XMERR,^TMP("XMERR",$J)

 Q

HDISVM00  ;BPFO/JRP - SERVER TO RECEIVE XML MESSAGE;1/4/2005

 +1       ;;1.0;HEALTH DATA & INFORMATICS;**6**;Feb 22, 2005

 +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,HDISTASK

 +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       DO TASKBULL^XMXAPI(DUZ,NAME,.HDISPRAM,ERRARR,,.HDISFLAG,.HDISTASK)

 +16       IF $GET(XMERR)

               Begin DoDot:1

 +17      ;Error generating bulletin - log error text

 +18               DO ERR2XTMP^HDISVU01("HDI-XM","Server error bulletin",$NAME(^TMP("XMERR",$JOB)))

 +19               KILL XMERR,^TMP("XMERR",$JOB)

               End DoDot:1

 +20       QUIT