VistA-FOIAVistA/r/HEALTH_DATA_AND_INFORMATICS.../HDISVS03.m

136 lines
5.0 KiB
Mathematica
Raw Permalink Normal View History

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
;;