| [613] | 1 | HDISVM00 ;BPFO/JRP - SERVER TO RECEIVE XML MESSAGE;1/4/2005 | 
|---|
|  | 2 | ;;1.0;HEALTH DATA & INFORMATICS;**6**;Feb 22, 2005 | 
|---|
|  | 3 | ; | 
|---|
|  | 4 | XML ;Main entry point for XML server options | 
|---|
|  | 5 | ; Input: (As defined by MailMan and Kernel) | 
|---|
|  | 6 | ;        XMREC - Executable code to "read" next line of message | 
|---|
|  | 7 | ;        XQSUB - Subject of received message | 
|---|
|  | 8 | ;        XQSOP - Server option name | 
|---|
|  | 9 | ;        XQMSG,XMZ - Msg IEN in file 3.9 | 
|---|
|  | 10 | ;        XQSND,XMFROM - Msg sender | 
|---|
|  | 11 | ;Output: None | 
|---|
|  | 12 | ;  Note: Input is not checked (assumes existence) | 
|---|
|  | 13 | ; | 
|---|
|  | 14 | N XMLARR,PRSARR,ERRARR,STOP,LINE,TYPE | 
|---|
|  | 15 | ;Establish temporary globals | 
|---|
|  | 16 | S XMLARR=$NA(^TMP(XQSOP,$J,"XML")) | 
|---|
|  | 17 | S PRSARR=$NA(^TMP(XQSOP,$J,"PARSED")) | 
|---|
|  | 18 | S ERRARR=$NA(^TMP(XQSOP,$J,"ERROR")) | 
|---|
|  | 19 | K @XMLARR,@PRSARR,@ERRARR | 
|---|
|  | 20 | ;Copy message to temporary global | 
|---|
|  | 21 | S STOP=0 | 
|---|
|  | 22 | F LINE=1:1 D  Q:STOP | 
|---|
|  | 23 | .X XMREC | 
|---|
|  | 24 | .I $D(XMER) I (XMER<0) S STOP=1 Q | 
|---|
|  | 25 | .S @XMLARR@(LINE)=XMRG | 
|---|
|  | 26 | ;Parse message | 
|---|
|  | 27 | D SAX^HDISVM01(XMLARR,PRSARR) | 
|---|
|  | 28 | ;Get type of system out of parameter file | 
|---|
|  | 29 | S TYPE=+$$GETTYPE^HDISVF02() | 
|---|
|  | 30 | ;Process messages on centralized server | 
|---|
|  | 31 | I TYPE=2 D MAIN^HDISVS00(PRSARR,ERRARR) | 
|---|
|  | 32 | ;Process messages on VistA (client) system | 
|---|
|  | 33 | I TYPE=1 D MAIN^HDISVC00(PRSARR,ERRARR) | 
|---|
|  | 34 | ;Error(s) occurred | 
|---|
|  | 35 | I $D(@ERRARR) D | 
|---|
|  | 36 | .;Send error message | 
|---|
|  | 37 | .D ERROR(ERRARR,XQMSG,XQSOP,XMFROM) | 
|---|
|  | 38 | .;Set message status | 
|---|
|  | 39 | .S X=$$SRVTIME^XMS1(XQMSG,"S."_XQSOP,"ERROR FOUND DURING PROCESSING") | 
|---|
|  | 40 | ;Delete message (don't delete if errors found) | 
|---|
|  | 41 | I '$D(@ERRARR) D ZAPSERV^XMXAPI("S."_XQSOP,XQMSG) | 
|---|
|  | 42 | ;Done | 
|---|
|  | 43 | K @XMLARR,@PRSARR,@ERRARR | 
|---|
|  | 44 | Q | 
|---|
|  | 45 | ; | 
|---|
|  | 46 | ERROR(ERRARR,MSGNUM,SRVR,SNDR) ;Send error message | 
|---|
|  | 47 | ; Input : ERRARR - Error array (closed root) | 
|---|
|  | 48 | ;         MSGNUM - Message number of received message (XMZ) | 
|---|
|  | 49 | ;         SRVR - Name of server option (XQSOP) | 
|---|
|  | 50 | ;         SNDR - Sender of message (XMFROM) | 
|---|
|  | 51 | ;Output : None | 
|---|
|  | 52 | ; Notes : Existance/validity of input assumed (internal call) | 
|---|
|  | 53 | N NAME,HDISPRAM,HDISFLAG,HDISTASK | 
|---|
|  | 54 | ;Set bulletin parameters | 
|---|
|  | 55 | S HDISPRAM(1)=MSGNUM | 
|---|
|  | 56 | S HDISPRAM(2)=SNDR | 
|---|
|  | 57 | S HDISPRAM(3)=SRVR | 
|---|
|  | 58 | ;Send bulletin | 
|---|
|  | 59 | S NAME="HDIS XML MSG PROCESS ERROR" | 
|---|
|  | 60 | S HDISFLAG("FROM")="HDIS XML MESSAGE SERVER" | 
|---|
|  | 61 | D TASKBULL^XMXAPI(DUZ,NAME,.HDISPRAM,ERRARR,,.HDISFLAG,.HDISTASK) | 
|---|
|  | 62 | I $G(XMERR) D | 
|---|
|  | 63 | .;Error generating bulletin - log error text | 
|---|
|  | 64 | .D ERR2XTMP^HDISVU01("HDI-XM","Server error bulletin",$NA(^TMP("XMERR",$J))) | 
|---|
|  | 65 | .K XMERR,^TMP("XMERR",$J) | 
|---|
|  | 66 | Q | 
|---|