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
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISVS03 5247 printed Sep 23, 2025@19:33:10 Page 2
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
STATUS(PRSARR,ERRARR) ;Process status update from VistA system
+1 ; Input : PRSARR - Array containing parsed XML document (closed root)
+2 ; This is the output of SAX^HDISVM01
+3 ; ERRARR - Array to output errors in (closed root)
+4 ;Output : None
+5 ; ERRARR(x) = Error text (if applicable)
+6 ; Notes : ERRARR is initialized (KILLed) on input
+7 ;
+8 ;Processing of all status updates disabled - throw error and quit
+9 IF $$GETSDIS^HDISVF03()
Begin DoDot:1
+10 NEW TMP
+11 SET TMP="STATUS^HDISVS03: Processing of status updates by central "
+12 SET TMP=TMP_"server is currently disabled"
+13 DO ADDERR^HDISVC00(TMP,ERRARR)
End DoDot:1
QUIT
+14 NEW EINDX,ESUBS,AINDX,ASUBS,DATA,TMP,DATE,STATPTR,SRCTYPE,SYSPTR
+15 NEW SOURCE,MAILMAN,FILE,FIELD,STAT,STATDT,INDX,OOPS,CODE,CODEPTR
+16 SET EINDX=$NAME(@PRSARR@("EINDX"))
+17 SET ESUBS=$NAME(@PRSARR@("ESUBS"))
+18 SET AINDX=$NAME(@PRSARR@("AINDX"))
+19 SET ASUBS=$NAME(@PRSARR@("ASUBS"))
+20 SET DATA=$NAME(@PRSARR@("DATA"))
+21 SET OOPS=0
+22 SET ERRARR=$GET(ERRARR)
+23 IF ERRARR'=""
KILL @ERRARR
+24 SET PRSARR=$GET(PRSARR)
+25 IF PRSARR=""
Begin DoDot:1
+26 SET TMP="SATUS^HDISVS03: Input parameter PRSARR was not passed"
+27 DO ADDERR^HDISVC00(TMP,ERRARR)
+28 SET OOPS=1
End DoDot:1
QUIT
+29 IF '$DATA(@PRSARR)
Begin DoDot:1
+30 SET TMP="STATUS^HDISVS0S: Input array "_PRSARR_" (PRSARR) does not exist"
+31 DO ADDERR^HDISVC00(TMP,ERRARR)
+32 SET OOPS=1
End DoDot:1
QUIT
+33 ;Ensure all elements are indexed
+34 FOR X=1:1
SET TMP=$PIECE($TEXT(ELEMENTS+X),";;",2)
if TMP=""
QUIT
Begin DoDot:1
+35 IF '$DATA(@EINDX@(TMP))
Begin DoDot:2
+36 SET TMP="XML element '"_TMP_"' was not found in the XML document"
+37 DO ADDERR^HDISVC00(TMP,ERRARR)
+38 SET OOPS=1
End DoDot:2
End DoDot:1
+39 ;Ensure that 'HDISParameters' is the root element
+40 IF $GET(@ESUBS@(1))'="HDISParameters"
Begin DoDot:1
+41 SET TMP="'HDISParameters' was not the root element in the XML document"
+42 DO ADDERR^HDISVC00(TMP,ERRARR)
+43 SET OOPS=1
End DoDot:1
+44 ;Errors found - quit
+45 IF OOPS
QUIT
+46 ;Process 'HDISParameters' portion of XML doc
+47 SET INDX=@EINDX@("HDISParameters")
+48 ;Get elements
+49 SET SOURCE=$GET(@DATA@(INDX,1,@EINDX@("Source"),1,"V"))
+50 SET SRCTYPE=$GET(@DATA@(INDX,1,@EINDX@("SourceType"),1,"V"))
+51 SET MAILMAN=$GET(@DATA@(INDX,1,@EINDX@("MailManDomain"),1,"V"))
+52 SET FILE=$GET(@DATA@(INDX,1,@EINDX@("FileNumber"),1,"V"))
+53 SET FIELD=$GET(@DATA@(INDX,1,@EINDX@("FieldNumber"),1,"V"))
+54 SET STAT=$GET(@DATA@(INDX,1,@EINDX@("StatusCode"),1,"V"))
+55 SET STATDT=$GET(@DATA@(INDX,1,@EINDX@("StatusDateTime"),1,"V"))
+56 ;Validate elements
+57 FOR TMP="SOURCE","MAILMAN","FILE","FIELD","STAT","STATDT","SRCTYPE"
IF $GET(@TMP)=""
Begin DoDot:1
+58 SET Y="Source"
+59 IF TMP="SRCTYPE"
SET Y="SourceType"
+60 IF TMP="MAILMAN"
SET Y="MailManDomain"
+61 IF TMP="FILE"
SET Y="FileNumber"
+62 IF TMP="FIELD"
SET Y="FieldNumber"
+63 IF TMP="STAT"
SET Y="StatusCode"
+64 IF TMP="STATDT"
SET Y="StatusDateTime"
+65 SET X="XML element '"_TMP_"' did not have a value"
+66 DO ADDERR^HDISVC00(X,ERRARR)
+67 SET OOPS=1
End DoDot:1
+68 ;Validate facility number
+69 IF SOURCE'=""
IF '$$FACPTR^HDISVF01(SOURCE)
Begin DoDot:1
+70 SET TMP="Value of XML element 'Source' ("_SOURCE
+71 SET TMP=TMP_") is not a valid facility number"
+72 DO ADDERR^HDISVC00(TMP,ERRARR)
+73 SET OOPS=1
End DoDot:1
+74 ;Get pointer to system
+75 IF 'OOPS
IF '$$FINDSYS^HDISVF07(MAILMAN,SOURCE,SRCTYPE,1,.SYSPTR)
Begin DoDot:1
+76 SET TMP="Entry for XML elements 'Source' ("_SOURCE_"), MailManDomain "
+77 SET TMP=TMP_"("_MAILMAN_"), and 'SourceType' ("_SRCTYPE_") could not "
+78 SET TMP="be found/created in HDIS SYSTEM file (#7718.21)"
+79 DO ADDERR^HDISVC00(TMP,ERRARR)
+80 SET OOPS=1
End DoDot:1
+81 ;Make sure entry in HDIS Parameter file exists for system
+82 IF 'OOPS
IF '$$GETPTR^HDISVF10(SYSPTR)
IF '$$PARAMINI^HDISVF10(SYSPTR,"","","",1)
Begin DoDot:1
+83 SET TMP="Entry for XML elements 'Source' ("_SOURCE_"), 'MailManDomain' "
+84 SET TMP=TMP_"("_MAILMAN_"), and 'SourceType' ("_SRCTYPE_") could not "
+85 SET TMP="be found/created in HDIS PARAMETER file (#7718.29)"
+86 DO ADDERR^HDISVC00(TMP,ERRARR)
+87 SET OOPS=1
End DoDot:1
+88 ;Processing of status updates from specific system disabled
+89 IF 'OOPS
IF $$GETSDIS^HDISVF03(SYSPTR)
Begin DoDot:1
+90 SET TMP="Processing of status udpates from 'Source' ("_SOURCE_"), "
+91 SET TMP=TMP_"'MailManDomain' ("_MAILMAN_"), and 'SourceType' ("
+92 SET TMP=TMP_SRCTYPE_") currently disabled"
+93 DO ADDERR^HDISVC00(TMP,ERRARR)
+94 SET OOPS=1
End DoDot:1
+95 ;Errors found - quit
+96 IF OOPS
QUIT
+97 ;Translate client's status code to a server status code
+98 ; Server status codes currently mirror the client status codes
+99 SET CODEPTR=0
+100 IF STAT'=""
IF '$$GETIEN^HDISVF06(STAT,2,.CODEPTR)
Begin DoDot:1
+101 SET TMP="Unable to convert value of 'StatusCode' ("_STAT
+102 SET TMP=TMP_") to it's server side equivalent"
+103 DO ADDERR^HDISVC00(TMP,ERRARR)
+104 SET OOPS=1
+105 SET CODEPTR=0
End DoDot:1
+106 IF CODEPTR
IF '$$GETCODE^HDISVF06(CODEPTR,.CODE)
Begin DoDot:1
+107 SET TMP="Unable to convert value of 'StatusCode' ("_STAT
+108 SET TMP=TMP_") to it's server side equivalent"
+109 DO ADDERR^HDISVC00(TMP,ERRARR)
+110 SET OOPS=1
End DoDot:1
+111 ;Convert status date/time to FileMan format
+112 IF STATDT'=""
SET DATE=$$XMLTFM^HDISVU01(STATDT,1)
IF DATE=""
Begin DoDot:1
+113 SET TMP="Unable to convert value of 'StatusDateTime' ("_STATDT
+114 SET TMP=TMP_") to FileMan format"
+115 DO ADDERR^HDISVC00(TMP,ERRARR)
+116 SET OOPS=1
End DoDot:1
+117 ;Errors found - quit
+118 IF OOPS
QUIT
+119 ;Store status
+120 DO SETSTAT^HDISVF01(FILE,FIELD,CODE,DATE,2,SOURCE,MAILMAN,SRCTYPE)
+121 QUIT
+122 ;
ELEMENTS ;List of required elements in XML document
+1 ;;HDISParameters
+2 ;;Source
+3 ;;SourceType
+4 ;;MailManDomain
+5 ;;FileNumber
+6 ;;FieldNumber
+7 ;;StatusCode
+8 ;;StatusDateTime
+9 ;;
