HDISVS01 ;BPFO/JRP - PROCESS RECEIVED XML DATA;12/20/2004
;;1.0;HEALTH DATA & INFORMATICS;**1**;Feb 22, 2005
;
VUID(PRSARR,ERRARR) ;Process XML data 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 VUID requests disabled - throw error and quit
I $$GETVFAIL^HDISVF02() D Q
.N TMP
.S TMP="VUID^HDISVS01: Processing of VUID requests by central server"
.S TMP=TMP_" is currently disabled"
.D ADDERR^HDISVC00(TMP,ERRARR)
N EINDX,ESUBS,AINDX,ASUBS,DATA,TMP,FFPTR,DOMPTR,XMLDOC
N DOMAIN,SOURCE,MAILMAN,INDX,OOPS,SYSPTR,SRCTYPE,FILE,FIELD
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 FFARR=$NA(^TMP("HDISVS01",$J,"FFARR"))
S XMLDOC=$NA(^TMP("HDISVS01",$J,"XMLDOC"))
K @FFARR,@XMLDOC
S OOPS=0
S ERRARR=$G(ERRARR)
I ERRARR'="" K @ERRARR
S PRSARR=$G(PRSARR)
I PRSARR="" D Q
.S TMP="VUID^HDISVS01: Input parameter PRSARR was not passed"
.D ADDERR^HDISVC00(TMP,ERRARR)
.S OOPS=1
I '$D(@PRSARR) D Q
.S TMP="VUID^HDISVS01: 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 'Domain' is the root element
I $G(@ESUBS@(1))'="Domain" D
.S TMP="'Domain' was not the root element in the XML document"
.D ADDERR^HDISVC00(TMP,ERRARR)
.S OOPS=1
;Errors found - quit
I OOPS Q
;Process 'Domain' portion of XML doc
S INDX=@EINDX@("Domain")
;Get elements
S DOMAIN=$G(@DATA@(INDX,1,@EINDX@("DomainName"),1,"V"))
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"))
;Validate elements
F TMP="DOMAIN","SOURCE","MAILMAN","SRCTYPE" I $G(@TMP)="" D
.S Y="DomainName"
.I TMP="SOURCE" S Y="Source"
.I TMP="SRCTYPE" S Y="SourceType"
.I TMP="MAILMAN" S Y="MailManDomain"
.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
;Errors found - quit
I OOPS Q
;Get pointers
I '$$GETIEN^HDISVF09(DOMAIN,.DOMPTR) D
.S TMP="Entry for XML element 'DomainName' ("_DOMAIN_") could not be "
.S TMP=TMP_"found in HDIS DOMAIN file (#7115.1)"
.D ADDERR^HDISVC00(TMP,ERRARR)
.S OOPS=1
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=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=TMP_"be found/created in HDIS PARAMETER file (#7718.29)"
.D ADDERR^HDISVC00(TMP,ERRARR)
.S OOPS=1
;Processing of VUID requests from specific system disabled
I 'OOPS I $$GETVFAIL^HDISVF02(SYSPTR) D
.S TMP="Processing of VUID requests 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
;Process 'File' portion
D FILE($NA(@DATA@(INDX,1)),EINDX,AINDX,SYSPTR,FFARR,ERRARR)
;Error - don't continue
I +$O(@ERRARR@(0)) K @FFARR Q
;Build/send return XML document(s)
S FFPTR=""
F S FFPTR=+$O(@FFARR@(FFPTR)) Q:'FFPTR D
.S TMP=$$GETFF^HDISVF05(FFPTR,.FILE,.FIELD)
.K @XMLDOC
.;Status update (building msg)
.D ADDSTAT^HDISVF01(FFPTR,SYSPTR,102,2)
.;Build XML document
.I $$FILE^HDISVSFX(DOMPTR,SYSPTR,FFPTR,XMLDOC)<1 D Q
..;Error
..S TMP="Unable to build XML document containing VUID information for"
..S TMP=TMP_" file "_FILE_" (field "_FIELD_") in the "_DOMAIN
..S TMP=TMP_" domain to facility "_SOURCE_" ("_MAILMAN_")"
..D ADDERR^HDISVC00(TMP,ERRARR)
..;Status update (error)
..D ADDSTAT^HDISVF01(FFPTR,SYSPTR,104,2)
.;Send XML document
.I $$SNDXML^HDISVM02(XMLDOC,1,,SYSPTR)<1 D Q
..;Error
..S TMP="Unable to send XML document containing VUID information for"
..S TMP=TMP_" file "_FILE_" (field "_FIELD_") in the "_DOMAIN
..S TMP=TMP_" domain to facility "_SOURCE_" ("_MAILMAN_")"
..D ADDERR^HDISVC00(TMP,ERRARR)
..;Status update (error)
..D ADDSTAT^HDISVF01(FFPTR,SYSPTR,104,2)
.;Status update (msg sent)
.D ADDSTAT^HDISVF01(FFPTR,SYSPTR,103,2)
K @FFARR,@XMLDOC
Q
;
FILE(DATA,EINDX,AINDX,SYSPTR,FFARR,ERRARR) ;Process 'File' portion of XML document
; Input : DATA - Array reference from which the 'File' element
; begins (closed root)
; EINDX - Element index array (closed root)
; AINDX - Attribute index array (closed root)
; SYSPTR - Pointer to HDIS SYSTEM file (#7118.21)
; FFARR - Array to output File/Field values (closed root)
; ERRARR - Error array (closed root)
;Output : None
; @FFARR@(Ptr) = ""
; Ptr - Pointer to HDIS FILE/FIELD file (#7115.6)
; @ERRARR@(x) = Error text (if applicable)
; Notes : Existance/validity of input assumed (internal call)
N INDX,REP,FILE,FIELD,OOPS,FFPTR,LASTERR
S INDX=@EINDX@("File")
S REP=0
F S REP=+$O(@DATA@(INDX,REP)) Q:'REP D
.S OOPS=0
.;Get elements
.S FILE=$G(@DATA@(INDX,REP,@EINDX@("FileNumber"),1,"V"))
.S FIELD=$G(@DATA@(INDX,REP,@EINDX@("FieldNumber"),1,"V"))
.;Validate elements
.F TMP="FILE","FIELD" I $G(@TMP)="" D
..S Y="FileNumber"
..I TMP="FIELD" S Y="FieldNumber"
..S X="XML element '"_TMP_"' did not have a value"
..D ADDERR^HDISVC00(X,ERRARR)
..S OOPS=1
.;Convert file & field to pointer
.I FILE I FIELD I '$$GETIEN^HDISVF05(FILE,FIELD,.FFPTR) D
..S TMP="Values of XML elements 'FileNumber' ("_FILE
..S TMP=TMP_") and 'FieldNumber ("_FIELD_") not found in HDIS"
..S TMP=TMP_" FILE/FIELD file (#7115.6)"
..D ADDERR^HDISVC00(TMP,ERRARR)
..S OOPS=1
.;Problem(s) found - don't continue
.I OOPS Q
.;Add File/Field to output array
.S @FFARR@(FFPTR)=""
.;Status update (start VUID assign)
.D ADDSTAT^HDISVF01(FFPTR,SYSPTR,101,2)
.;Remember last error number
.S LASTERR=+$O(@ERRARR@(""),-1)
.;Process 'Term' portion
.D TERM^HDISVS02($NA(@DATA@(INDX,REP)),EINDX,AINDX,SYSPTR,FFPTR,ERRARR)
.;Error(s) added - status update (error)
.I LASTERR'=+$O(@ERRARR@(""),-1) D ADDSTAT^HDISVF01(FFPTR,SYSPTR,104,2)
Q
;
ELEMENTS ;List of required elements in XML document
;;Domain
;;DomainName
;;Source
;;SourceType
;;MailManDomain
;;File
;;FileNumber
;;FieldNumber
;;Term
;;TermName
;;VUID
;;FacilityInternalReference
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISVS01 7539 printed Sep 23, 2025@19:33:08 Page 2
HDISVS01 ;BPFO/JRP - PROCESS RECEIVED XML DATA;12/20/2004
+1 ;;1.0;HEALTH DATA & INFORMATICS;**1**;Feb 22, 2005
+2 ;
VUID(PRSARR,ERRARR) ;Process XML data 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 VUID requests disabled - throw error and quit
+9 IF $$GETVFAIL^HDISVF02()
Begin DoDot:1
+10 NEW TMP
+11 SET TMP="VUID^HDISVS01: Processing of VUID requests by central server"
+12 SET TMP=TMP_" is currently disabled"
+13 DO ADDERR^HDISVC00(TMP,ERRARR)
End DoDot:1
QUIT
+14 NEW EINDX,ESUBS,AINDX,ASUBS,DATA,TMP,FFPTR,DOMPTR,XMLDOC
+15 NEW DOMAIN,SOURCE,MAILMAN,INDX,OOPS,SYSPTR,SRCTYPE,FILE,FIELD
+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 FFARR=$NAME(^TMP("HDISVS01",$JOB,"FFARR"))
+22 SET XMLDOC=$NAME(^TMP("HDISVS01",$JOB,"XMLDOC"))
+23 KILL @FFARR,@XMLDOC
+24 SET OOPS=0
+25 SET ERRARR=$GET(ERRARR)
+26 IF ERRARR'=""
KILL @ERRARR
+27 SET PRSARR=$GET(PRSARR)
+28 IF PRSARR=""
Begin DoDot:1
+29 SET TMP="VUID^HDISVS01: Input parameter PRSARR was not passed"
+30 DO ADDERR^HDISVC00(TMP,ERRARR)
+31 SET OOPS=1
End DoDot:1
QUIT
+32 IF '$DATA(@PRSARR)
Begin DoDot:1
+33 SET TMP="VUID^HDISVS01: Input array "_PRSARR_" (PRSARR) does not exist"
+34 DO ADDERR^HDISVC00(TMP,ERRARR)
+35 SET OOPS=1
End DoDot:1
QUIT
+36 ;Ensure all elements are indexed
+37 FOR X=1:1
SET TMP=$PIECE($TEXT(ELEMENTS+X),";;",2)
if TMP=""
QUIT
Begin DoDot:1
+38 IF '$DATA(@EINDX@(TMP))
Begin DoDot:2
+39 SET TMP="XML element '"_TMP_"' was not found in the XML document"
+40 DO ADDERR^HDISVC00(TMP,ERRARR)
+41 SET OOPS=1
End DoDot:2
End DoDot:1
+42 ;Ensure that 'Domain' is the root element
+43 IF $GET(@ESUBS@(1))'="Domain"
Begin DoDot:1
+44 SET TMP="'Domain' was not the root element in the XML document"
+45 DO ADDERR^HDISVC00(TMP,ERRARR)
+46 SET OOPS=1
End DoDot:1
+47 ;Errors found - quit
+48 IF OOPS
QUIT
+49 ;Process 'Domain' portion of XML doc
+50 SET INDX=@EINDX@("Domain")
+51 ;Get elements
+52 SET DOMAIN=$GET(@DATA@(INDX,1,@EINDX@("DomainName"),1,"V"))
+53 SET SOURCE=$GET(@DATA@(INDX,1,@EINDX@("Source"),1,"V"))
+54 SET SRCTYPE=$GET(@DATA@(INDX,1,@EINDX@("SourceType"),1,"V"))
+55 SET MAILMAN=$GET(@DATA@(INDX,1,@EINDX@("MailManDomain"),1,"V"))
+56 ;Validate elements
+57 FOR TMP="DOMAIN","SOURCE","MAILMAN","SRCTYPE"
IF $GET(@TMP)=""
Begin DoDot:1
+58 SET Y="DomainName"
+59 IF TMP="SOURCE"
SET Y="Source"
+60 IF TMP="SRCTYPE"
SET Y="SourceType"
+61 IF TMP="MAILMAN"
SET Y="MailManDomain"
+62 SET X="XML element '"_TMP_"' did not have a value"
+63 DO ADDERR^HDISVC00(X,ERRARR)
+64 SET OOPS=1
End DoDot:1
+65 ;Validate facility number
+66 IF SOURCE'=""
IF '$$FACPTR^HDISVF01(SOURCE)
Begin DoDot:1
+67 SET TMP="Value of XML element 'Source' ("_SOURCE
+68 SET TMP=TMP_") is not a valid facility number"
+69 DO ADDERR^HDISVC00(TMP,ERRARR)
+70 SET OOPS=1
End DoDot:1
+71 ;Errors found - quit
+72 IF OOPS
QUIT
+73 ;Get pointers
+74 IF '$$GETIEN^HDISVF09(DOMAIN,.DOMPTR)
Begin DoDot:1
+75 SET TMP="Entry for XML element 'DomainName' ("_DOMAIN_") could not be "
+76 SET TMP=TMP_"found in HDIS DOMAIN file (#7115.1)"
+77 DO ADDERR^HDISVC00(TMP,ERRARR)
+78 SET OOPS=1
End DoDot:1
+79 IF '$$FINDSYS^HDISVF07(MAILMAN,SOURCE,SRCTYPE,1,.SYSPTR)
Begin DoDot:1
+80 SET TMP="Entry for XML elements 'Source' ("_SOURCE_"), MailManDomain "
+81 SET TMP=TMP_"("_MAILMAN_"), and 'SourceType' ("_SRCTYPE_") could not "
+82 SET TMP=TMP_"be found/created in HDIS SYSTEM file (#7718.21)"
+83 DO ADDERR^HDISVC00(TMP,ERRARR)
+84 SET OOPS=1
End DoDot:1
+85 ;Make sure entry in HDIS Parameter file exists for system
+86 IF 'OOPS
IF '$$GETPTR^HDISVF10(SYSPTR)
IF '$$PARAMINI^HDISVF10(SYSPTR,"","","",1)
Begin DoDot:1
+87 SET TMP="Entry for XML elements 'Source' ("_SOURCE_"), 'MailManDomain' "
+88 SET TMP=TMP_"("_MAILMAN_"), and 'SourceType' ("_SRCTYPE_") could not "
+89 SET TMP=TMP_"be found/created in HDIS PARAMETER file (#7718.29)"
+90 DO ADDERR^HDISVC00(TMP,ERRARR)
+91 SET OOPS=1
End DoDot:1
+92 ;Processing of VUID requests from specific system disabled
+93 IF 'OOPS
IF $$GETVFAIL^HDISVF02(SYSPTR)
Begin DoDot:1
+94 SET TMP="Processing of VUID requests from 'Source' ("_SOURCE_"), "
+95 SET TMP=TMP_"'MailManDomain' ("_MAILMAN_"), and 'SourceType' ("
+96 SET TMP=TMP_SRCTYPE_") currently disabled"
+97 DO ADDERR^HDISVC00(TMP,ERRARR)
+98 SET OOPS=1
End DoDot:1
+99 ;Errors found - quit
+100 IF OOPS
QUIT
+101 ;Process 'File' portion
+102 DO FILE($NAME(@DATA@(INDX,1)),EINDX,AINDX,SYSPTR,FFARR,ERRARR)
+103 ;Error - don't continue
+104 IF +$ORDER(@ERRARR@(0))
KILL @FFARR
QUIT
+105 ;Build/send return XML document(s)
+106 SET FFPTR=""
+107 FOR
SET FFPTR=+$ORDER(@FFARR@(FFPTR))
if 'FFPTR
QUIT
Begin DoDot:1
+108 SET TMP=$$GETFF^HDISVF05(FFPTR,.FILE,.FIELD)
+109 KILL @XMLDOC
+110 ;Status update (building msg)
+111 DO ADDSTAT^HDISVF01(FFPTR,SYSPTR,102,2)
+112 ;Build XML document
+113 IF $$FILE^HDISVSFX(DOMPTR,SYSPTR,FFPTR,XMLDOC)<1
Begin DoDot:2
+114 ;Error
+115 SET TMP="Unable to build XML document containing VUID information for"
+116 SET TMP=TMP_" file "_FILE_" (field "_FIELD_") in the "_DOMAIN
+117 SET TMP=TMP_" domain to facility "_SOURCE_" ("_MAILMAN_")"
+118 DO ADDERR^HDISVC00(TMP,ERRARR)
+119 ;Status update (error)
+120 DO ADDSTAT^HDISVF01(FFPTR,SYSPTR,104,2)
End DoDot:2
QUIT
+121 ;Send XML document
+122 IF $$SNDXML^HDISVM02(XMLDOC,1,,SYSPTR)<1
Begin DoDot:2
+123 ;Error
+124 SET TMP="Unable to send XML document containing VUID information for"
+125 SET TMP=TMP_" file "_FILE_" (field "_FIELD_") in the "_DOMAIN
+126 SET TMP=TMP_" domain to facility "_SOURCE_" ("_MAILMAN_")"
+127 DO ADDERR^HDISVC00(TMP,ERRARR)
+128 ;Status update (error)
+129 DO ADDSTAT^HDISVF01(FFPTR,SYSPTR,104,2)
End DoDot:2
QUIT
+130 ;Status update (msg sent)
+131 DO ADDSTAT^HDISVF01(FFPTR,SYSPTR,103,2)
End DoDot:1
+132 KILL @FFARR,@XMLDOC
+133 QUIT
+134 ;
FILE(DATA,EINDX,AINDX,SYSPTR,FFARR,ERRARR) ;Process 'File' portion of XML document
+1 ; Input : DATA - Array reference from which the 'File' element
+2 ; begins (closed root)
+3 ; EINDX - Element index array (closed root)
+4 ; AINDX - Attribute index array (closed root)
+5 ; SYSPTR - Pointer to HDIS SYSTEM file (#7118.21)
+6 ; FFARR - Array to output File/Field values (closed root)
+7 ; ERRARR - Error array (closed root)
+8 ;Output : None
+9 ; @FFARR@(Ptr) = ""
+10 ; Ptr - Pointer to HDIS FILE/FIELD file (#7115.6)
+11 ; @ERRARR@(x) = Error text (if applicable)
+12 ; Notes : Existance/validity of input assumed (internal call)
+13 NEW INDX,REP,FILE,FIELD,OOPS,FFPTR,LASTERR
+14 SET INDX=@EINDX@("File")
+15 SET REP=0
+16 FOR
SET REP=+$ORDER(@DATA@(INDX,REP))
if 'REP
QUIT
Begin DoDot:1
+17 SET OOPS=0
+18 ;Get elements
+19 SET FILE=$GET(@DATA@(INDX,REP,@EINDX@("FileNumber"),1,"V"))
+20 SET FIELD=$GET(@DATA@(INDX,REP,@EINDX@("FieldNumber"),1,"V"))
+21 ;Validate elements
+22 FOR TMP="FILE","FIELD"
IF $GET(@TMP)=""
Begin DoDot:2
+23 SET Y="FileNumber"
+24 IF TMP="FIELD"
SET Y="FieldNumber"
+25 SET X="XML element '"_TMP_"' did not have a value"
+26 DO ADDERR^HDISVC00(X,ERRARR)
+27 SET OOPS=1
End DoDot:2
+28 ;Convert file & field to pointer
+29 IF FILE
IF FIELD
IF '$$GETIEN^HDISVF05(FILE,FIELD,.FFPTR)
Begin DoDot:2
+30 SET TMP="Values of XML elements 'FileNumber' ("_FILE
+31 SET TMP=TMP_") and 'FieldNumber ("_FIELD_") not found in HDIS"
+32 SET TMP=TMP_" FILE/FIELD file (#7115.6)"
+33 DO ADDERR^HDISVC00(TMP,ERRARR)
+34 SET OOPS=1
End DoDot:2
+35 ;Problem(s) found - don't continue
+36 IF OOPS
QUIT
+37 ;Add File/Field to output array
+38 SET @FFARR@(FFPTR)=""
+39 ;Status update (start VUID assign)
+40 DO ADDSTAT^HDISVF01(FFPTR,SYSPTR,101,2)
+41 ;Remember last error number
+42 SET LASTERR=+$ORDER(@ERRARR@(""),-1)
+43 ;Process 'Term' portion
+44 DO TERM^HDISVS02($NAME(@DATA@(INDX,REP)),EINDX,AINDX,SYSPTR,FFPTR,ERRARR)
+45 ;Error(s) added - status update (error)
+46 IF LASTERR'=+$ORDER(@ERRARR@(""),-1)
DO ADDSTAT^HDISVF01(FFPTR,SYSPTR,104,2)
End DoDot:1
+47 QUIT
+48 ;
ELEMENTS ;List of required elements in XML document
+1 ;;Domain
+2 ;;DomainName
+3 ;;Source
+4 ;;SourceType
+5 ;;MailManDomain
+6 ;;File
+7 ;;FileNumber
+8 ;;FieldNumber
+9 ;;Term
+10 ;;TermName
+11 ;;VUID
+12 ;;FacilityInternalReference
+13 ;;
