source: WorldVistAEHR/trunk/r/HEALTH_DATA_AND_INFORMATICS-HDI/HDISVS01.m@ 1800

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

initial load of WorldVistAEHR
File size: 7.2 KB
RevLine 
[613]1HDISVS01 ;BPFO/JRP - PROCESS RECEIVED XML DATA;12/20/2004
2 ;;1.0;HEALTH DATA & INFORMATICS;**1**;Feb 22, 2005
3 ;
4VUID(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 ;
139FILE(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 ;
188ELEMENTS ;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 ;;
Note: See TracBrowser for help on using the repository browser.