Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HDISVS03

HDISVS03.m

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