source: FOIAVistA/trunk/r/HEALTH_DATA_AND_INFORMATICS-HDI/HDISVC01.m@ 1705

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1HDISVC01 ;BPFO/JRP - PROCESS RECEIVED XML DATA;12/20/2004 ; 10 Mar 2005 11:23 AM
2 ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
3 ;
4DOMAIN(PRSARR,ERRARR) ;Process XML data from VUID Server
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 VUID data disabled - throw error and quit
13 I $$GETVFAIL^HDISVF02() D Q
14 .N TMP
15 .S TMP="DOMAIN^HDISVC01: Processing of VUID data from central server"
16 .S TMP=TMP_" is currently disabled"
17 .D ADDERR^HDISVC00(TMP,ERRARR)
18 N EINDX,ESUBS,AINDX,ASUBS,DATA,TMP,X,Y
19 N DOMAIN,SOURCE,MAILMAN,INDX,OOPS
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 OOPS=0
26 S ERRARR=$G(ERRARR)
27 I ERRARR'="" K @ERRARR
28 S PRSARR=$G(PRSARR)
29 I PRSARR="" D Q
30 .S TMP="DOMAIN^HDISVC01: Input parameter PRSARR was not passed"
31 .D ADDERR^HDISVC00(TMP,ERRARR)
32 .S OOPS=1
33 I '$D(@PRSARR) D Q
34 .S TMP="DOMAIN^HDISVC01: Input array "_PRSARR_" (PRSARR) does not exist"
35 .D ADDERR^HDISVC00(TMP,ERRARR)
36 .S OOPS=1
37 ;Ensure all elements are indexed
38 F X=1:1 S TMP=$P($T(ELEMENTS+X),";;",2) Q:TMP="" D
39 .I '$D(@EINDX@(TMP)) D
40 ..S TMP="XML element '"_TMP_"' was not found in the XML document"
41 ..D ADDERR^HDISVC00(TMP,ERRARR)
42 ..S OOPS=1
43 ;Ensure that 'Domain' is the root element
44 I $G(@ESUBS@(1))'="Domain" D
45 .S TMP="'Domain' was not the root element in the XML document"
46 .D ADDERR^HDISVC00(TMP,ERRARR)
47 .S OOPS=1
48 ;Errors found - quit
49 I OOPS Q
50 ;Process 'Domain' portion of XML doc
51 S INDX=@EINDX@("Domain")
52 ;Get elements
53 S DOMAIN=$G(@DATA@(INDX,1,@EINDX@("DomainName"),1,"V"))
54 S SOURCE=$G(@DATA@(INDX,1,@EINDX@("Source"),1,"V"))
55 S MAILMAN=$G(@DATA@(INDX,1,@EINDX@("MailManDomain"),1,"V"))
56 ;Validate elements
57 F TMP="DOMAIN","SOURCE","MAILMAN" I $G(@TMP)="" D
58 .S Y="DomainName"
59 .I TMP="SOURCE" S Y="Source"
60 .I TMP="MAILMAN" S Y="MailManDomain"
61 .S X="XML element '"_TMP_"' did not have a value"
62 .D ADDERR^HDISVC00(X,ERRARR)
63 .S OOPS=1
64 ;Ensure that 'Source' matches local number
65 I SOURCE'="" I SOURCE'=$$FACNUM^HDISVF01() D
66 .S TMP="Value of XML element 'Source' ("_SOURCE
67 .S TMP=TMP_") does not match local facility number"
68 .D ADDERR^HDISVC00(TMP,ERRARR)
69 .S OOPS=1
70 ;Ensure that 'MailManDomain' matches local domain
71 I MAILMAN'="" I MAILMAN'=$G(^XMB("NETNAME")) D
72 .S TMP="Value of XML element 'MailManDomain' ("_MAILMAN
73 .S TMP=TMP_") does not match local domain"
74 .D ADDERR^HDISVC00(TMP,ERRARR)
75 .S OOPS=1
76 ;Errors found - quit
77 I OOPS Q
78 ;Process 'File' portion
79 D FILE($NA(@DATA@(INDX,1)),EINDX,AINDX,ERRARR,DOMAIN)
80 Q
81 ;
82FILE(DATA,EINDX,AINDX,ERRARR,DOMAIN) ;Process 'File' portion of XML document
83 ; Input : DATA - Array reference from which the 'File' element
84 ; begins (closed root)
85 ; EINDX - Element index array (closed root)
86 ; AINDX - Attribute index array (closed root)
87 ; ERRARR - Error array (closed root)
88 ; DOMAIN - Value of 'DomainName' element
89 ;Output : None
90 ; @ERRARR@(x) = Error text (if applicable)
91 ; Notes : Existance/validity of input assumed (internal call)
92 N INDX,REP,FILE,FIELD,OOPS,EXIST,LASTERR,X,Y,TMP
93 N FACPTR,FACNAME,FACNUM,IPADD,SYSTYPE,FILENAME
94 S INDX=@EINDX@("File")
95 S REP=0
96 F S REP=+$O(@DATA@(INDX,REP)) Q:'REP D
97 .S OOPS=0
98 .;Get elements
99 .S FILE=$G(@DATA@(INDX,REP,@EINDX@("FileNumber"),1,"V"))
100 .S FIELD=$G(@DATA@(INDX,REP,@EINDX@("FieldNumber"),1,"V"))
101 .;Validate elements
102 .F TMP="FILE","FIELD" I $G(@TMP)="" D
103 ..S Y="FileNumber"
104 ..I TMP="FIELD" S Y="FieldNumber"
105 ..S X="XML element '"_TMP_"' did not have a value"
106 ..D ADDERR^HDISVC00(X,ERRARR)
107 ..S OOPS=1
108 .;Errors found - quit
109 .I OOPS Q
110 .I '$$VFILE^DILFD(FILE) D
111 ..S TMP="Repetition number "_REP_" of XML element 'FileNumber' "
112 ..S TMP=TMP_"is not a valid file number"
113 ..D ADDERR^HDISVC00(TMP,ERRARR)
114 ..S OOPS=1
115 .I 'OOPS I '$$VFIELD^DILFD(FILE,FIELD) D
116 ..S TMP="Repetition number "_REP_" of XML element 'FieldNumber' "
117 ..S TMP=TMP_"is not a valid field number"
118 ..D ADDERR^HDISVC00(TMP,ERRARR)
119 ..S OOPS=1
120 .;Errors found - quit
121 .I OOPS Q
122 .;Status update - VUIDs received
123 .S TMP=$$STATUPD^HDISVCUT(FILE,FIELD,3)
124 .;Make sure VUID and status fields are defined
125 .I '$$SETCODE^HDISVC02(FILE,FIELD) S EXIST=$$FLDXST(FILE) I 'EXIST D
126 ..F TMP=2:1:4 I '$P(EXIST,"^",TMP) D
127 ...S X="File number "_FILE_" is missing field number "
128 ...I TMP=2 S X=X_"99.99 (VUID)"
129 ...I TMP=3 S X=X_"99.991 (EFFECTIVE DATE multiple)"
130 ...I TMP=4 S X=X_".02 (STATUS) of EFFECTIVE DATE multiple (99.991)"
131 ...D ADDERR^HDISVC00(X,ERRARR)
132 ...I TMP=3 S TMP=4
133 ..S OOPS=1
134 .;Problem(s) found - don't continue
135 .I OOPS D Q
136 ..;Status update (error)
137 ..S TMP=$$STATUPD^HDISVCUT(FILE,FIELD,5)
138 .;Remember last error number
139 .S LASTERR=+$O(@ERRARR@(""),-1)
140 .;Process 'Term' portion
141 .D TERM^HDISVC02($NA(@DATA@(INDX,REP)),EINDX,AINDX,ERRARR,FILE,FIELD)
142 .;Error(s) added - status update (error)
143 .I LASTERR'=+$O(@ERRARR@(""),-1) S TMP=$$STATUPD^HDISVCUT(FILE,FIELD,5) Q
144 .;Status update (VUIDs assigned)
145 .S TMP=$$STATUPD^HDISVCUT(FILE,FIELD,4)
146 .;Notify ERT that VUID's have been stored
147 .K FACPTR,IPADD,SYSTYPE
148 .I '$$GETFAC^HDISVF07(,.FACPTR) S FACPTR=$$FACPTR^HDISVF01()
149 .I '$$GETDIP^HDISVF07(,.IPADD) S IPADD=$G(^XMB("NETNAME"))
150 .I '$$GETTYPE^HDISVF07(,,.SYSTYPE) D
151 ..S SYSTYPE=$$PROD^XUPROD()
152 ..S SYSTYPE=$S(SYSTYPE:"PRODUCTION",1:"TEST")
153 .S TMP=$$NS^XUAF4(FACPTR)
154 .S FACNAME=$P(TMP,"^",1)
155 .S FACNUM=$P(TMP,"^",2)
156 .I (FACNAME="")!(FACNUM="") D
157 ..S TMP=$$SITE^VASITE()
158 ..S FACNAME=$P(TMP,"^",2)
159 ..S FACNUM=$P(TMP,"^",3)
160 .S FACNAME=FACNAME_" (#"_FACNUM_") with Domain/IP Address "_IPADD
161 .S FILENAME=$$GET1^DID(FILE,,,"NAME")
162 .S FILENAME=FILENAME_" (#"_FILE_")"
163 .D ERTBULL^HDISVF09(FACNAME,FILENAME,$$NOW^XLFDT(),SYSTYPE,FACNUM,FILE)
164 Q
165 ;
166FLDXST(FILE) ;Check for existance of VUID and status fields
167 ; Input : FILE - File number
168 ;Output : 1 = Required VUID and status fields exist
169 ; 0^VUID^Status^StatusDate = One or more fields missing
170 ; 0 put in piece of missing field
171 ; Notes : Existance/validity of input assumed (internal call)
172 N VUID,STAT,STDT,OUTPUT,SUBFILE
173 S (OUTPUT,VUID,STAT,STDT)=1
174 ;VUID field
175 I '$$VFIELD^DILFD(FILE,99.99) D
176 .S OUTPUT=0
177 .S VUID=0
178 ;EFFECTIVE DATE multiple
179 I '$$VFIELD^DILFD(FILE,99.991) D
180 .S OUTPUT=0
181 .S (STAT,STDT)=0
182 S SUBFILE=+$$GET1^DID(FILE,99.991,"","SPECIFIER")
183 I 'SUBFILE D
184 .S OUTPUT=0
185 .S (STAT,STDT)=0
186 ;STATUS sub-field
187 I SUBFILE I '$$VFIELD^DILFD(SUBFILE,.02) D
188 .S OUTPUT=0
189 .S STDT=0
190 I 'OUTPUT S OUTPUT=OUTPUT_"^"_VUID_"^"_STAT_"^"_STDT
191 Q OUTPUT
192 ;
193ELEMENTS ;List of required elements in XML document
194 ;;Domain
195 ;;DomainName
196 ;;Source
197 ;;MailManDomain
198 ;;File
199 ;;FileNumber
200 ;;FieldNumber
201 ;;Term
202 ;;TermName
203 ;;VUID
204 ;;NationalTerm
205 ;;FacilityInternalReference
206 ;;
Note: See TracBrowser for help on using the repository browser.