source: WorldVistAEHR/trunk/r/HEALTH_DATA_AND_INFORMATICS-HDI/HDISVS03.m@ 738

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

initial load of WorldVistAEHR
File size: 5.0 KB
Line 
1HDISVS03 ;BPFO/JRP - PROCESS RECEIVED XML DATA;1/6/2005 ; 08 Mar 2005 9:10 AM
2 ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
3STATUS(PRSARR,ERRARR) ;Process status update from VistA system
4 ; Input : PRSARR - Array containing parsed XML document (closed root)
5 ; This is the output of SAX^HDISVM01
6 ; ERRARR - Array to output errors in (closed root)
7 ;Output : None
8 ; ERRARR(x) = Error text (if applicable)
9 ; Notes : ERRARR is initialized (KILLed) on input
10 ;
11 ;Processing of all status updates disabled - throw error and quit
12 I $$GETSDIS^HDISVF03() D Q
13 .N TMP
14 .S TMP="STATUS^HDISVS03: Processing of status updates by central "
15 .S TMP=TMP_"server is currently disabled"
16 .D ADDERR^HDISVC00(TMP,ERRARR)
17 N EINDX,ESUBS,AINDX,ASUBS,DATA,TMP,DATE,STATPTR,SRCTYPE,SYSPTR
18 N SOURCE,MAILMAN,FILE,FIELD,STAT,STATDT,INDX,OOPS,CODE,CODEPTR
19 S EINDX=$NA(@PRSARR@("EINDX"))
20 S ESUBS=$NA(@PRSARR@("ESUBS"))
21 S AINDX=$NA(@PRSARR@("AINDX"))
22 S ASUBS=$NA(@PRSARR@("ASUBS"))
23 S DATA=$NA(@PRSARR@("DATA"))
24 S OOPS=0
25 S ERRARR=$G(ERRARR)
26 I ERRARR'="" K @ERRARR
27 S PRSARR=$G(PRSARR)
28 I PRSARR="" D Q
29 .S TMP="SATUS^HDISVS03: Input parameter PRSARR was not passed"
30 .D ADDERR^HDISVC00(TMP,ERRARR)
31 .S OOPS=1
32 I '$D(@PRSARR) D Q
33 .S TMP="STATUS^HDISVS0S: Input array "_PRSARR_" (PRSARR) does not exist"
34 .D ADDERR^HDISVC00(TMP,ERRARR)
35 .S OOPS=1
36 ;Ensure all elements are indexed
37 F X=1:1 S TMP=$P($T(ELEMENTS+X),";;",2) Q:TMP="" D
38 .I '$D(@EINDX@(TMP)) D
39 ..S TMP="XML element '"_TMP_"' was not found in the XML document"
40 ..D ADDERR^HDISVC00(TMP,ERRARR)
41 ..S OOPS=1
42 ;Ensure that 'HDISParameters' is the root element
43 I $G(@ESUBS@(1))'="HDISParameters" D
44 .S TMP="'HDISParameters' was not the root element in the XML document"
45 .D ADDERR^HDISVC00(TMP,ERRARR)
46 .S OOPS=1
47 ;Errors found - quit
48 I OOPS Q
49 ;Process 'HDISParameters' portion of XML doc
50 S INDX=@EINDX@("HDISParameters")
51 ;Get elements
52 S SOURCE=$G(@DATA@(INDX,1,@EINDX@("Source"),1,"V"))
53 S SRCTYPE=$G(@DATA@(INDX,1,@EINDX@("SourceType"),1,"V"))
54 S MAILMAN=$G(@DATA@(INDX,1,@EINDX@("MailManDomain"),1,"V"))
55 S FILE=$G(@DATA@(INDX,1,@EINDX@("FileNumber"),1,"V"))
56 S FIELD=$G(@DATA@(INDX,1,@EINDX@("FieldNumber"),1,"V"))
57 S STAT=$G(@DATA@(INDX,1,@EINDX@("StatusCode"),1,"V"))
58 S STATDT=$G(@DATA@(INDX,1,@EINDX@("StatusDateTime"),1,"V"))
59 ;Validate elements
60 F TMP="SOURCE","MAILMAN","FILE","FIELD","STAT","STATDT","SRCTYPE" I $G(@TMP)="" D
61 .S Y="Source"
62 .I TMP="SRCTYPE" S Y="SourceType"
63 .I TMP="MAILMAN" S Y="MailManDomain"
64 .I TMP="FILE" S Y="FileNumber"
65 .I TMP="FIELD" S Y="FieldNumber"
66 .I TMP="STAT" S Y="StatusCode"
67 .I TMP="STATDT" S Y="StatusDateTime"
68 .S X="XML element '"_TMP_"' did not have a value"
69 .D ADDERR^HDISVC00(X,ERRARR)
70 .S OOPS=1
71 ;Validate facility number
72 I SOURCE'="" I '$$FACPTR^HDISVF01(SOURCE) D
73 .S TMP="Value of XML element 'Source' ("_SOURCE
74 .S TMP=TMP_") is not a valid facility number"
75 .D ADDERR^HDISVC00(TMP,ERRARR)
76 .S OOPS=1
77 ;Get pointer to system
78 I 'OOPS I '$$FINDSYS^HDISVF07(MAILMAN,SOURCE,SRCTYPE,1,.SYSPTR) D
79 .S TMP="Entry for XML elements 'Source' ("_SOURCE_"), MailManDomain "
80 .S TMP=TMP_"("_MAILMAN_"), and 'SourceType' ("_SRCTYPE_") could not "
81 .S TMP="be found/created in HDIS SYSTEM file (#7718.21)"
82 .D ADDERR^HDISVC00(TMP,ERRARR)
83 .S OOPS=1
84 ;Make sure entry in HDIS Parameter file exists for system
85 I 'OOPS I '$$GETPTR^HDISVF10(SYSPTR) I '$$PARAMINI^HDISVF10(SYSPTR,"","","",1) D
86 .S TMP="Entry for XML elements 'Source' ("_SOURCE_"), 'MailManDomain' "
87 .S TMP=TMP_"("_MAILMAN_"), and 'SourceType' ("_SRCTYPE_") could not "
88 .S TMP="be found/created in HDIS PARAMETER file (#7718.29)"
89 .D ADDERR^HDISVC00(TMP,ERRARR)
90 .S OOPS=1
91 ;Processing of status updates from specific system disabled
92 I 'OOPS I $$GETSDIS^HDISVF03(SYSPTR) D
93 .S TMP="Processing of status udpates from 'Source' ("_SOURCE_"), "
94 .S TMP=TMP_"'MailManDomain' ("_MAILMAN_"), and 'SourceType' ("
95 .S TMP=TMP_SRCTYPE_") currently disabled"
96 .D ADDERR^HDISVC00(TMP,ERRARR)
97 .S OOPS=1
98 ;Errors found - quit
99 I OOPS Q
100 ;Translate client's status code to a server status code
101 ; Server status codes currently mirror the client status codes
102 S CODEPTR=0
103 I STAT'="" I '$$GETIEN^HDISVF06(STAT,2,.CODEPTR) D
104 .S TMP="Unable to convert value of 'StatusCode' ("_STAT
105 .S TMP=TMP_") to it's server side equivalent"
106 .D ADDERR^HDISVC00(TMP,ERRARR)
107 .S OOPS=1
108 .S CODEPTR=0
109 I CODEPTR I '$$GETCODE^HDISVF06(CODEPTR,.CODE) D
110 .S TMP="Unable to convert value of 'StatusCode' ("_STAT
111 .S TMP=TMP_") to it's server side equivalent"
112 .D ADDERR^HDISVC00(TMP,ERRARR)
113 .S OOPS=1
114 ;Convert status date/time to FileMan format
115 I STATDT'="" S DATE=$$XMLTFM^HDISVU01(STATDT,1) I DATE="" D
116 .S TMP="Unable to convert value of 'StatusDateTime' ("_STATDT
117 .S TMP=TMP_") to FileMan format"
118 .D ADDERR^HDISVC00(TMP,ERRARR)
119 .S OOPS=1
120 ;Errors found - quit
121 I OOPS Q
122 ;Store status
123 D SETSTAT^HDISVF01(FILE,FIELD,CODE,DATE,2,SOURCE,MAILMAN,SRCTYPE)
124 Q
125 ;
126ELEMENTS ;List of required elements in XML document
127 ;;HDISParameters
128 ;;Source
129 ;;SourceType
130 ;;MailManDomain
131 ;;FileNumber
132 ;;FieldNumber
133 ;;StatusCode
134 ;;StatusDateTime
135 ;;
Note: See TracBrowser for help on using the repository browser.