source: WorldVistAEHR/trunk/r/HEALTH_DATA_AND_INFORMATICS-HDI/HDISVM00.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1HDISVM00 ;BPFO/JRP - SERVER TO RECEIVE XML MESSAGE;1/4/2005
2 ;;1.0;HEALTH DATA & INFORMATICS;**6**;Feb 22, 2005
3 ;
4XML ;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 ;
46ERROR(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
Note: See TracBrowser for help on using the repository browser.