136 lines
5.0 KiB
Mathematica
136 lines
5.0 KiB
Mathematica
HDISVS03 ;BPFO/JRP - PROCESS RECEIVED XML DATA;1/6/2005 ; 08 Mar 2005 9:10 AM
|
|
;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
|
|
STATUS(PRSARR,ERRARR) ;Process status update from VistA system
|
|
; Input : PRSARR - Array containing parsed XML document (closed root)
|
|
; This is the output of SAX^HDISVM01
|
|
; ERRARR - Array to output errors in (closed root)
|
|
;Output : None
|
|
; ERRARR(x) = Error text (if applicable)
|
|
; Notes : ERRARR is initialized (KILLed) on input
|
|
;
|
|
;Processing of all status updates disabled - throw error and quit
|
|
I $$GETSDIS^HDISVF03() D Q
|
|
.N TMP
|
|
.S TMP="STATUS^HDISVS03: Processing of status updates by central "
|
|
.S TMP=TMP_"server is currently disabled"
|
|
.D ADDERR^HDISVC00(TMP,ERRARR)
|
|
N EINDX,ESUBS,AINDX,ASUBS,DATA,TMP,DATE,STATPTR,SRCTYPE,SYSPTR
|
|
N SOURCE,MAILMAN,FILE,FIELD,STAT,STATDT,INDX,OOPS,CODE,CODEPTR
|
|
S EINDX=$NA(@PRSARR@("EINDX"))
|
|
S ESUBS=$NA(@PRSARR@("ESUBS"))
|
|
S AINDX=$NA(@PRSARR@("AINDX"))
|
|
S ASUBS=$NA(@PRSARR@("ASUBS"))
|
|
S DATA=$NA(@PRSARR@("DATA"))
|
|
S OOPS=0
|
|
S ERRARR=$G(ERRARR)
|
|
I ERRARR'="" K @ERRARR
|
|
S PRSARR=$G(PRSARR)
|
|
I PRSARR="" D Q
|
|
.S TMP="SATUS^HDISVS03: Input parameter PRSARR was not passed"
|
|
.D ADDERR^HDISVC00(TMP,ERRARR)
|
|
.S OOPS=1
|
|
I '$D(@PRSARR) D Q
|
|
.S TMP="STATUS^HDISVS0S: Input array "_PRSARR_" (PRSARR) does not exist"
|
|
.D ADDERR^HDISVC00(TMP,ERRARR)
|
|
.S OOPS=1
|
|
;Ensure all elements are indexed
|
|
F X=1:1 S TMP=$P($T(ELEMENTS+X),";;",2) Q:TMP="" D
|
|
.I '$D(@EINDX@(TMP)) D
|
|
..S TMP="XML element '"_TMP_"' was not found in the XML document"
|
|
..D ADDERR^HDISVC00(TMP,ERRARR)
|
|
..S OOPS=1
|
|
;Ensure that 'HDISParameters' is the root element
|
|
I $G(@ESUBS@(1))'="HDISParameters" D
|
|
.S TMP="'HDISParameters' was not the root element in the XML document"
|
|
.D ADDERR^HDISVC00(TMP,ERRARR)
|
|
.S OOPS=1
|
|
;Errors found - quit
|
|
I OOPS Q
|
|
;Process 'HDISParameters' portion of XML doc
|
|
S INDX=@EINDX@("HDISParameters")
|
|
;Get elements
|
|
S SOURCE=$G(@DATA@(INDX,1,@EINDX@("Source"),1,"V"))
|
|
S SRCTYPE=$G(@DATA@(INDX,1,@EINDX@("SourceType"),1,"V"))
|
|
S MAILMAN=$G(@DATA@(INDX,1,@EINDX@("MailManDomain"),1,"V"))
|
|
S FILE=$G(@DATA@(INDX,1,@EINDX@("FileNumber"),1,"V"))
|
|
S FIELD=$G(@DATA@(INDX,1,@EINDX@("FieldNumber"),1,"V"))
|
|
S STAT=$G(@DATA@(INDX,1,@EINDX@("StatusCode"),1,"V"))
|
|
S STATDT=$G(@DATA@(INDX,1,@EINDX@("StatusDateTime"),1,"V"))
|
|
;Validate elements
|
|
F TMP="SOURCE","MAILMAN","FILE","FIELD","STAT","STATDT","SRCTYPE" I $G(@TMP)="" D
|
|
.S Y="Source"
|
|
.I TMP="SRCTYPE" S Y="SourceType"
|
|
.I TMP="MAILMAN" S Y="MailManDomain"
|
|
.I TMP="FILE" S Y="FileNumber"
|
|
.I TMP="FIELD" S Y="FieldNumber"
|
|
.I TMP="STAT" S Y="StatusCode"
|
|
.I TMP="STATDT" S Y="StatusDateTime"
|
|
.S X="XML element '"_TMP_"' did not have a value"
|
|
.D ADDERR^HDISVC00(X,ERRARR)
|
|
.S OOPS=1
|
|
;Validate facility number
|
|
I SOURCE'="" I '$$FACPTR^HDISVF01(SOURCE) D
|
|
.S TMP="Value of XML element 'Source' ("_SOURCE
|
|
.S TMP=TMP_") is not a valid facility number"
|
|
.D ADDERR^HDISVC00(TMP,ERRARR)
|
|
.S OOPS=1
|
|
;Get pointer to system
|
|
I 'OOPS I '$$FINDSYS^HDISVF07(MAILMAN,SOURCE,SRCTYPE,1,.SYSPTR) D
|
|
.S TMP="Entry for XML elements 'Source' ("_SOURCE_"), MailManDomain "
|
|
.S TMP=TMP_"("_MAILMAN_"), and 'SourceType' ("_SRCTYPE_") could not "
|
|
.S TMP="be found/created in HDIS SYSTEM file (#7718.21)"
|
|
.D ADDERR^HDISVC00(TMP,ERRARR)
|
|
.S OOPS=1
|
|
;Make sure entry in HDIS Parameter file exists for system
|
|
I 'OOPS I '$$GETPTR^HDISVF10(SYSPTR) I '$$PARAMINI^HDISVF10(SYSPTR,"","","",1) D
|
|
.S TMP="Entry for XML elements 'Source' ("_SOURCE_"), 'MailManDomain' "
|
|
.S TMP=TMP_"("_MAILMAN_"), and 'SourceType' ("_SRCTYPE_") could not "
|
|
.S TMP="be found/created in HDIS PARAMETER file (#7718.29)"
|
|
.D ADDERR^HDISVC00(TMP,ERRARR)
|
|
.S OOPS=1
|
|
;Processing of status updates from specific system disabled
|
|
I 'OOPS I $$GETSDIS^HDISVF03(SYSPTR) D
|
|
.S TMP="Processing of status udpates from 'Source' ("_SOURCE_"), "
|
|
.S TMP=TMP_"'MailManDomain' ("_MAILMAN_"), and 'SourceType' ("
|
|
.S TMP=TMP_SRCTYPE_") currently disabled"
|
|
.D ADDERR^HDISVC00(TMP,ERRARR)
|
|
.S OOPS=1
|
|
;Errors found - quit
|
|
I OOPS Q
|
|
;Translate client's status code to a server status code
|
|
; Server status codes currently mirror the client status codes
|
|
S CODEPTR=0
|
|
I STAT'="" I '$$GETIEN^HDISVF06(STAT,2,.CODEPTR) D
|
|
.S TMP="Unable to convert value of 'StatusCode' ("_STAT
|
|
.S TMP=TMP_") to it's server side equivalent"
|
|
.D ADDERR^HDISVC00(TMP,ERRARR)
|
|
.S OOPS=1
|
|
.S CODEPTR=0
|
|
I CODEPTR I '$$GETCODE^HDISVF06(CODEPTR,.CODE) D
|
|
.S TMP="Unable to convert value of 'StatusCode' ("_STAT
|
|
.S TMP=TMP_") to it's server side equivalent"
|
|
.D ADDERR^HDISVC00(TMP,ERRARR)
|
|
.S OOPS=1
|
|
;Convert status date/time to FileMan format
|
|
I STATDT'="" S DATE=$$XMLTFM^HDISVU01(STATDT,1) I DATE="" D
|
|
.S TMP="Unable to convert value of 'StatusDateTime' ("_STATDT
|
|
.S TMP=TMP_") to FileMan format"
|
|
.D ADDERR^HDISVC00(TMP,ERRARR)
|
|
.S OOPS=1
|
|
;Errors found - quit
|
|
I OOPS Q
|
|
;Store status
|
|
D SETSTAT^HDISVF01(FILE,FIELD,CODE,DATE,2,SOURCE,MAILMAN,SRCTYPE)
|
|
Q
|
|
;
|
|
ELEMENTS ;List of required elements in XML document
|
|
;;HDISParameters
|
|
;;Source
|
|
;;SourceType
|
|
;;MailManDomain
|
|
;;FileNumber
|
|
;;FieldNumber
|
|
;;StatusCode
|
|
;;StatusDateTime
|
|
;;
|