| 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
 | 
|---|