1 | HDISVS01 ;BPFO/JRP - PROCESS RECEIVED XML DATA;12/20/2004
|
---|
2 | ;;1.0;HEALTH DATA & INFORMATICS;**1**;Feb 22, 2005
|
---|
3 | ;
|
---|
4 | VUID(PRSARR,ERRARR) ;Process XML data from VistA system
|
---|
5 | ; Input : PRSARR - Array containing parsed XML document (closed root)
|
---|
6 | ; This is the output of SAX^HDISVM01
|
---|
7 | ; ERRARR - Array to output errors in (closed root)
|
---|
8 | ;Output : None
|
---|
9 | ; @ERRARR@(x) = Error text (if applicable)
|
---|
10 | ; Notes : ERRARR is initialized (KILLed) on input
|
---|
11 | ;
|
---|
12 | ;Processing of all VUID requests disabled - throw error and quit
|
---|
13 | I $$GETVFAIL^HDISVF02() D Q
|
---|
14 | .N TMP
|
---|
15 | .S TMP="VUID^HDISVS01: Processing of VUID requests by central server"
|
---|
16 | .S TMP=TMP_" is currently disabled"
|
---|
17 | .D ADDERR^HDISVC00(TMP,ERRARR)
|
---|
18 | N EINDX,ESUBS,AINDX,ASUBS,DATA,TMP,FFPTR,DOMPTR,XMLDOC
|
---|
19 | N DOMAIN,SOURCE,MAILMAN,INDX,OOPS,SYSPTR,SRCTYPE,FILE,FIELD
|
---|
20 | S EINDX=$NA(@PRSARR@("EINDX"))
|
---|
21 | S ESUBS=$NA(@PRSARR@("ESUBS"))
|
---|
22 | S AINDX=$NA(@PRSARR@("AINDX"))
|
---|
23 | S ASUBS=$NA(@PRSARR@("ASUBS"))
|
---|
24 | S DATA=$NA(@PRSARR@("DATA"))
|
---|
25 | S FFARR=$NA(^TMP("HDISVS01",$J,"FFARR"))
|
---|
26 | S XMLDOC=$NA(^TMP("HDISVS01",$J,"XMLDOC"))
|
---|
27 | K @FFARR,@XMLDOC
|
---|
28 | S OOPS=0
|
---|
29 | S ERRARR=$G(ERRARR)
|
---|
30 | I ERRARR'="" K @ERRARR
|
---|
31 | S PRSARR=$G(PRSARR)
|
---|
32 | I PRSARR="" D Q
|
---|
33 | .S TMP="VUID^HDISVS01: Input parameter PRSARR was not passed"
|
---|
34 | .D ADDERR^HDISVC00(TMP,ERRARR)
|
---|
35 | .S OOPS=1
|
---|
36 | I '$D(@PRSARR) D Q
|
---|
37 | .S TMP="VUID^HDISVS01: Input array "_PRSARR_" (PRSARR) does not exist"
|
---|
38 | .D ADDERR^HDISVC00(TMP,ERRARR)
|
---|
39 | .S OOPS=1
|
---|
40 | ;Ensure all elements are indexed
|
---|
41 | F X=1:1 S TMP=$P($T(ELEMENTS+X),";;",2) Q:TMP="" D
|
---|
42 | .I '$D(@EINDX@(TMP)) D
|
---|
43 | ..S TMP="XML element '"_TMP_"' was not found in the XML document"
|
---|
44 | ..D ADDERR^HDISVC00(TMP,ERRARR)
|
---|
45 | ..S OOPS=1
|
---|
46 | ;Ensure that 'Domain' is the root element
|
---|
47 | I $G(@ESUBS@(1))'="Domain" D
|
---|
48 | .S TMP="'Domain' was not the root element in the XML document"
|
---|
49 | .D ADDERR^HDISVC00(TMP,ERRARR)
|
---|
50 | .S OOPS=1
|
---|
51 | ;Errors found - quit
|
---|
52 | I OOPS Q
|
---|
53 | ;Process 'Domain' portion of XML doc
|
---|
54 | S INDX=@EINDX@("Domain")
|
---|
55 | ;Get elements
|
---|
56 | S DOMAIN=$G(@DATA@(INDX,1,@EINDX@("DomainName"),1,"V"))
|
---|
57 | S SOURCE=$G(@DATA@(INDX,1,@EINDX@("Source"),1,"V"))
|
---|
58 | S SRCTYPE=$G(@DATA@(INDX,1,@EINDX@("SourceType"),1,"V"))
|
---|
59 | S MAILMAN=$G(@DATA@(INDX,1,@EINDX@("MailManDomain"),1,"V"))
|
---|
60 | ;Validate elements
|
---|
61 | F TMP="DOMAIN","SOURCE","MAILMAN","SRCTYPE" I $G(@TMP)="" D
|
---|
62 | .S Y="DomainName"
|
---|
63 | .I TMP="SOURCE" S Y="Source"
|
---|
64 | .I TMP="SRCTYPE" S Y="SourceType"
|
---|
65 | .I TMP="MAILMAN" S Y="MailManDomain"
|
---|
66 | .S X="XML element '"_TMP_"' did not have a value"
|
---|
67 | .D ADDERR^HDISVC00(X,ERRARR)
|
---|
68 | .S OOPS=1
|
---|
69 | ;Validate facility number
|
---|
70 | I SOURCE'="" I '$$FACPTR^HDISVF01(SOURCE) D
|
---|
71 | .S TMP="Value of XML element 'Source' ("_SOURCE
|
---|
72 | .S TMP=TMP_") is not a valid facility number"
|
---|
73 | .D ADDERR^HDISVC00(TMP,ERRARR)
|
---|
74 | .S OOPS=1
|
---|
75 | ;Errors found - quit
|
---|
76 | I OOPS Q
|
---|
77 | ;Get pointers
|
---|
78 | I '$$GETIEN^HDISVF09(DOMAIN,.DOMPTR) D
|
---|
79 | .S TMP="Entry for XML element 'DomainName' ("_DOMAIN_") could not be "
|
---|
80 | .S TMP=TMP_"found in HDIS DOMAIN file (#7115.1)"
|
---|
81 | .D ADDERR^HDISVC00(TMP,ERRARR)
|
---|
82 | .S OOPS=1
|
---|
83 | I '$$FINDSYS^HDISVF07(MAILMAN,SOURCE,SRCTYPE,1,.SYSPTR) D
|
---|
84 | .S TMP="Entry for XML elements 'Source' ("_SOURCE_"), MailManDomain "
|
---|
85 | .S TMP=TMP_"("_MAILMAN_"), and 'SourceType' ("_SRCTYPE_") could not "
|
---|
86 | .S TMP=TMP_"be found/created in HDIS SYSTEM file (#7718.21)"
|
---|
87 | .D ADDERR^HDISVC00(TMP,ERRARR)
|
---|
88 | .S OOPS=1
|
---|
89 | ;Make sure entry in HDIS Parameter file exists for system
|
---|
90 | I 'OOPS I '$$GETPTR^HDISVF10(SYSPTR) I '$$PARAMINI^HDISVF10(SYSPTR,"","","",1) D
|
---|
91 | .S TMP="Entry for XML elements 'Source' ("_SOURCE_"), 'MailManDomain' "
|
---|
92 | .S TMP=TMP_"("_MAILMAN_"), and 'SourceType' ("_SRCTYPE_") could not "
|
---|
93 | .S TMP=TMP_"be found/created in HDIS PARAMETER file (#7718.29)"
|
---|
94 | .D ADDERR^HDISVC00(TMP,ERRARR)
|
---|
95 | .S OOPS=1
|
---|
96 | ;Processing of VUID requests from specific system disabled
|
---|
97 | I 'OOPS I $$GETVFAIL^HDISVF02(SYSPTR) D
|
---|
98 | .S TMP="Processing of VUID requests from 'Source' ("_SOURCE_"), "
|
---|
99 | .S TMP=TMP_"'MailManDomain' ("_MAILMAN_"), and 'SourceType' ("
|
---|
100 | .S TMP=TMP_SRCTYPE_") currently disabled"
|
---|
101 | .D ADDERR^HDISVC00(TMP,ERRARR)
|
---|
102 | .S OOPS=1
|
---|
103 | ;Errors found - quit
|
---|
104 | I OOPS Q
|
---|
105 | ;Process 'File' portion
|
---|
106 | D FILE($NA(@DATA@(INDX,1)),EINDX,AINDX,SYSPTR,FFARR,ERRARR)
|
---|
107 | ;Error - don't continue
|
---|
108 | I +$O(@ERRARR@(0)) K @FFARR Q
|
---|
109 | ;Build/send return XML document(s)
|
---|
110 | S FFPTR=""
|
---|
111 | F S FFPTR=+$O(@FFARR@(FFPTR)) Q:'FFPTR D
|
---|
112 | .S TMP=$$GETFF^HDISVF05(FFPTR,.FILE,.FIELD)
|
---|
113 | .K @XMLDOC
|
---|
114 | .;Status update (building msg)
|
---|
115 | .D ADDSTAT^HDISVF01(FFPTR,SYSPTR,102,2)
|
---|
116 | .;Build XML document
|
---|
117 | .I $$FILE^HDISVSFX(DOMPTR,SYSPTR,FFPTR,XMLDOC)<1 D Q
|
---|
118 | ..;Error
|
---|
119 | ..S TMP="Unable to build XML document containing VUID information for"
|
---|
120 | ..S TMP=TMP_" file "_FILE_" (field "_FIELD_") in the "_DOMAIN
|
---|
121 | ..S TMP=TMP_" domain to facility "_SOURCE_" ("_MAILMAN_")"
|
---|
122 | ..D ADDERR^HDISVC00(TMP,ERRARR)
|
---|
123 | ..;Status update (error)
|
---|
124 | ..D ADDSTAT^HDISVF01(FFPTR,SYSPTR,104,2)
|
---|
125 | .;Send XML document
|
---|
126 | .I $$SNDXML^HDISVM02(XMLDOC,1,,SYSPTR)<1 D Q
|
---|
127 | ..;Error
|
---|
128 | ..S TMP="Unable to send XML document containing VUID information for"
|
---|
129 | ..S TMP=TMP_" file "_FILE_" (field "_FIELD_") in the "_DOMAIN
|
---|
130 | ..S TMP=TMP_" domain to facility "_SOURCE_" ("_MAILMAN_")"
|
---|
131 | ..D ADDERR^HDISVC00(TMP,ERRARR)
|
---|
132 | ..;Status update (error)
|
---|
133 | ..D ADDSTAT^HDISVF01(FFPTR,SYSPTR,104,2)
|
---|
134 | .;Status update (msg sent)
|
---|
135 | .D ADDSTAT^HDISVF01(FFPTR,SYSPTR,103,2)
|
---|
136 | K @FFARR,@XMLDOC
|
---|
137 | Q
|
---|
138 | ;
|
---|
139 | FILE(DATA,EINDX,AINDX,SYSPTR,FFARR,ERRARR) ;Process 'File' portion of XML document
|
---|
140 | ; Input : DATA - Array reference from which the 'File' element
|
---|
141 | ; begins (closed root)
|
---|
142 | ; EINDX - Element index array (closed root)
|
---|
143 | ; AINDX - Attribute index array (closed root)
|
---|
144 | ; SYSPTR - Pointer to HDIS SYSTEM file (#7118.21)
|
---|
145 | ; FFARR - Array to output File/Field values (closed root)
|
---|
146 | ; ERRARR - Error array (closed root)
|
---|
147 | ;Output : None
|
---|
148 | ; @FFARR@(Ptr) = ""
|
---|
149 | ; Ptr - Pointer to HDIS FILE/FIELD file (#7115.6)
|
---|
150 | ; @ERRARR@(x) = Error text (if applicable)
|
---|
151 | ; Notes : Existance/validity of input assumed (internal call)
|
---|
152 | N INDX,REP,FILE,FIELD,OOPS,FFPTR,LASTERR
|
---|
153 | S INDX=@EINDX@("File")
|
---|
154 | S REP=0
|
---|
155 | F S REP=+$O(@DATA@(INDX,REP)) Q:'REP D
|
---|
156 | .S OOPS=0
|
---|
157 | .;Get elements
|
---|
158 | .S FILE=$G(@DATA@(INDX,REP,@EINDX@("FileNumber"),1,"V"))
|
---|
159 | .S FIELD=$G(@DATA@(INDX,REP,@EINDX@("FieldNumber"),1,"V"))
|
---|
160 | .;Validate elements
|
---|
161 | .F TMP="FILE","FIELD" I $G(@TMP)="" D
|
---|
162 | ..S Y="FileNumber"
|
---|
163 | ..I TMP="FIELD" S Y="FieldNumber"
|
---|
164 | ..S X="XML element '"_TMP_"' did not have a value"
|
---|
165 | ..D ADDERR^HDISVC00(X,ERRARR)
|
---|
166 | ..S OOPS=1
|
---|
167 | .;Convert file & field to pointer
|
---|
168 | .I FILE I FIELD I '$$GETIEN^HDISVF05(FILE,FIELD,.FFPTR) D
|
---|
169 | ..S TMP="Values of XML elements 'FileNumber' ("_FILE
|
---|
170 | ..S TMP=TMP_") and 'FieldNumber ("_FIELD_") not found in HDIS"
|
---|
171 | ..S TMP=TMP_" FILE/FIELD file (#7115.6)"
|
---|
172 | ..D ADDERR^HDISVC00(TMP,ERRARR)
|
---|
173 | ..S OOPS=1
|
---|
174 | .;Problem(s) found - don't continue
|
---|
175 | .I OOPS Q
|
---|
176 | .;Add File/Field to output array
|
---|
177 | .S @FFARR@(FFPTR)=""
|
---|
178 | .;Status update (start VUID assign)
|
---|
179 | .D ADDSTAT^HDISVF01(FFPTR,SYSPTR,101,2)
|
---|
180 | .;Remember last error number
|
---|
181 | .S LASTERR=+$O(@ERRARR@(""),-1)
|
---|
182 | .;Process 'Term' portion
|
---|
183 | .D TERM^HDISVS02($NA(@DATA@(INDX,REP)),EINDX,AINDX,SYSPTR,FFPTR,ERRARR)
|
---|
184 | .;Error(s) added - status update (error)
|
---|
185 | .I LASTERR'=+$O(@ERRARR@(""),-1) D ADDSTAT^HDISVF01(FFPTR,SYSPTR,104,2)
|
---|
186 | Q
|
---|
187 | ;
|
---|
188 | ELEMENTS ;List of required elements in XML document
|
---|
189 | ;;Domain
|
---|
190 | ;;DomainName
|
---|
191 | ;;Source
|
---|
192 | ;;SourceType
|
---|
193 | ;;MailManDomain
|
---|
194 | ;;File
|
---|
195 | ;;FileNumber
|
---|
196 | ;;FieldNumber
|
---|
197 | ;;Term
|
---|
198 | ;;TermName
|
---|
199 | ;;VUID
|
---|
200 | ;;FacilityInternalReference
|
---|
201 | ;;
|
---|