HDISVC01 ;BPFO/JRP - PROCESS RECEIVED XML DATA;12/20/2004 ; 10 Mar 2005 11:23 AM
;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
;
DOMAIN(PRSARR,ERRARR) ;Process XML data from VUID Server
; 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 VUID data disabled - throw error and quit
I $$GETVFAIL^HDISVF02() D Q
.N TMP
.S TMP="DOMAIN^HDISVC01: Processing of VUID data from central server"
.S TMP=TMP_" is currently disabled"
.D ADDERR^HDISVC00(TMP,ERRARR)
N EINDX,ESUBS,AINDX,ASUBS,DATA,TMP,X,Y
N DOMAIN,SOURCE,MAILMAN,INDX,OOPS
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="DOMAIN^HDISVC01: Input parameter PRSARR was not passed"
.D ADDERR^HDISVC00(TMP,ERRARR)
.S OOPS=1
I '$D(@PRSARR) D Q
.S TMP="DOMAIN^HDISVC01: 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 MAILMAN=$G(@DATA@(INDX,1,@EINDX@("MailManDomain"),1,"V"))
;Validate elements
F TMP="DOMAIN","SOURCE","MAILMAN" I $G(@TMP)="" D
.S Y="DomainName"
.I TMP="SOURCE" S Y="Source"
.I TMP="MAILMAN" S Y="MailManDomain"
.S X="XML element '"_TMP_"' did not have a value"
.D ADDERR^HDISVC00(X,ERRARR)
.S OOPS=1
;Ensure that 'Source' matches local number
I SOURCE'="" I SOURCE'=$$FACNUM^HDISVF01() D
.S TMP="Value of XML element 'Source' ("_SOURCE
.S TMP=TMP_") does not match local facility number"
.D ADDERR^HDISVC00(TMP,ERRARR)
.S OOPS=1
;Ensure that 'MailManDomain' matches local domain
I MAILMAN'="" I MAILMAN'=$G(^XMB("NETNAME")) D
.S TMP="Value of XML element 'MailManDomain' ("_MAILMAN
.S TMP=TMP_") does not match local domain"
.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,ERRARR,DOMAIN)
Q
;
FILE(DATA,EINDX,AINDX,ERRARR,DOMAIN) ;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)
; ERRARR - Error array (closed root)
; DOMAIN - Value of 'DomainName' element
;Output : None
; @ERRARR@(x) = Error text (if applicable)
; Notes : Existance/validity of input assumed (internal call)
N INDX,REP,FILE,FIELD,OOPS,EXIST,LASTERR,X,Y,TMP
N FACPTR,FACNAME,FACNUM,IPADD,SYSTYPE,FILENAME
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
.;Errors found - quit
.I OOPS Q
.I '$$VFILE^DILFD(FILE) D
..S TMP="Repetition number "_REP_" of XML element 'FileNumber' "
..S TMP=TMP_"is not a valid file number"
..D ADDERR^HDISVC00(TMP,ERRARR)
..S OOPS=1
.I 'OOPS I '$$VFIELD^DILFD(FILE,FIELD) D
..S TMP="Repetition number "_REP_" of XML element 'FieldNumber' "
..S TMP=TMP_"is not a valid field number"
..D ADDERR^HDISVC00(TMP,ERRARR)
..S OOPS=1
.;Errors found - quit
.I OOPS Q
.;Status update - VUIDs received
.S TMP=$$STATUPD^HDISVCUT(FILE,FIELD,3)
.;Make sure VUID and status fields are defined
.I '$$SETCODE^HDISVC02(FILE,FIELD) S EXIST=$$FLDXST(FILE) I 'EXIST D
..F TMP=2:1:4 I '$P(EXIST,"^",TMP) D
...S X="File number "_FILE_" is missing field number "
...I TMP=2 S X=X_"99.99 (VUID)"
...I TMP=3 S X=X_"99.991 (EFFECTIVE DATE multiple)"
...I TMP=4 S X=X_".02 (STATUS) of EFFECTIVE DATE multiple (99.991)"
...D ADDERR^HDISVC00(X,ERRARR)
...I TMP=3 S TMP=4
..S OOPS=1
.;Problem(s) found - don't continue
.I OOPS D Q
..;Status update (error)
..S TMP=$$STATUPD^HDISVCUT(FILE,FIELD,5)
.;Remember last error number
.S LASTERR=+$O(@ERRARR@(""),-1)
.;Process 'Term' portion
.D TERM^HDISVC02($NA(@DATA@(INDX,REP)),EINDX,AINDX,ERRARR,FILE,FIELD)
.;Error(s) added - status update (error)
.I LASTERR'=+$O(@ERRARR@(""),-1) S TMP=$$STATUPD^HDISVCUT(FILE,FIELD,5) Q
.;Status update (VUIDs assigned)
.S TMP=$$STATUPD^HDISVCUT(FILE,FIELD,4)
.;Notify ERT that VUID's have been stored
.K FACPTR,IPADD,SYSTYPE
.I '$$GETFAC^HDISVF07(,.FACPTR) S FACPTR=$$FACPTR^HDISVF01()
.I '$$GETDIP^HDISVF07(,.IPADD) S IPADD=$G(^XMB("NETNAME"))
.I '$$GETTYPE^HDISVF07(,,.SYSTYPE) D
..S SYSTYPE=$$PROD^XUPROD()
..S SYSTYPE=$S(SYSTYPE:"PRODUCTION",1:"TEST")
.S TMP=$$NS^XUAF4(FACPTR)
.S FACNAME=$P(TMP,"^",1)
.S FACNUM=$P(TMP,"^",2)
.I (FACNAME="")!(FACNUM="") D
..S TMP=$$SITE^VASITE()
..S FACNAME=$P(TMP,"^",2)
..S FACNUM=$P(TMP,"^",3)
.S FACNAME=FACNAME_" (#"_FACNUM_") with Domain/IP Address "_IPADD
.S FILENAME=$$GET1^DID(FILE,,,"NAME")
.S FILENAME=FILENAME_" (#"_FILE_")"
.D ERTBULL^HDISVF09(FACNAME,FILENAME,$$NOW^XLFDT(),SYSTYPE,FACNUM,FILE)
Q
;
FLDXST(FILE) ;Check for existance of VUID and status fields
; Input : FILE - File number
;Output : 1 = Required VUID and status fields exist
; 0^VUID^Status^StatusDate = One or more fields missing
; 0 put in piece of missing field
; Notes : Existance/validity of input assumed (internal call)
N VUID,STAT,STDT,OUTPUT,SUBFILE
S (OUTPUT,VUID,STAT,STDT)=1
;VUID field
I '$$VFIELD^DILFD(FILE,99.99) D
.S OUTPUT=0
.S VUID=0
;EFFECTIVE DATE multiple
I '$$VFIELD^DILFD(FILE,99.991) D
.S OUTPUT=0
.S (STAT,STDT)=0
S SUBFILE=+$$GET1^DID(FILE,99.991,"","SPECIFIER")
I 'SUBFILE D
.S OUTPUT=0
.S (STAT,STDT)=0
;STATUS sub-field
I SUBFILE I '$$VFIELD^DILFD(SUBFILE,.02) D
.S OUTPUT=0
.S STDT=0
I 'OUTPUT S OUTPUT=OUTPUT_"^"_VUID_"^"_STAT_"^"_STDT
Q OUTPUT
;
ELEMENTS ;List of required elements in XML document
;;Domain
;;DomainName
;;Source
;;MailManDomain
;;File
;;FileNumber
;;FieldNumber
;;Term
;;TermName
;;VUID
;;NationalTerm
;;FacilityInternalReference
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISVC01 7252 printed Sep 23, 2025@19:32:47 Page 2
HDISVC01 ;BPFO/JRP - PROCESS RECEIVED XML DATA;12/20/2004 ; 10 Mar 2005 11:23 AM
+1 ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
+2 ;
DOMAIN(PRSARR,ERRARR) ;Process XML data from VUID Server
+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 VUID data disabled - throw error and quit
+9 IF $$GETVFAIL^HDISVF02()
Begin DoDot:1
+10 NEW TMP
+11 SET TMP="DOMAIN^HDISVC01: Processing of VUID data from 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,X,Y
+15 NEW DOMAIN,SOURCE,MAILMAN,INDX,OOPS
+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="DOMAIN^HDISVC01: 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="DOMAIN^HDISVC01: 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 'Domain' is the root element
+40 IF $GET(@ESUBS@(1))'="Domain"
Begin DoDot:1
+41 SET TMP="'Domain' 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 'Domain' portion of XML doc
+47 SET INDX=@EINDX@("Domain")
+48 ;Get elements
+49 SET DOMAIN=$GET(@DATA@(INDX,1,@EINDX@("DomainName"),1,"V"))
+50 SET SOURCE=$GET(@DATA@(INDX,1,@EINDX@("Source"),1,"V"))
+51 SET MAILMAN=$GET(@DATA@(INDX,1,@EINDX@("MailManDomain"),1,"V"))
+52 ;Validate elements
+53 FOR TMP="DOMAIN","SOURCE","MAILMAN"
IF $GET(@TMP)=""
Begin DoDot:1
+54 SET Y="DomainName"
+55 IF TMP="SOURCE"
SET Y="Source"
+56 IF TMP="MAILMAN"
SET Y="MailManDomain"
+57 SET X="XML element '"_TMP_"' did not have a value"
+58 DO ADDERR^HDISVC00(X,ERRARR)
+59 SET OOPS=1
End DoDot:1
+60 ;Ensure that 'Source' matches local number
+61 IF SOURCE'=""
IF SOURCE'=$$FACNUM^HDISVF01()
Begin DoDot:1
+62 SET TMP="Value of XML element 'Source' ("_SOURCE
+63 SET TMP=TMP_") does not match local facility number"
+64 DO ADDERR^HDISVC00(TMP,ERRARR)
+65 SET OOPS=1
End DoDot:1
+66 ;Ensure that 'MailManDomain' matches local domain
+67 IF MAILMAN'=""
IF MAILMAN'=$GET(^XMB("NETNAME"))
Begin DoDot:1
+68 SET TMP="Value of XML element 'MailManDomain' ("_MAILMAN
+69 SET TMP=TMP_") does not match local domain"
+70 DO ADDERR^HDISVC00(TMP,ERRARR)
+71 SET OOPS=1
End DoDot:1
+72 ;Errors found - quit
+73 IF OOPS
QUIT
+74 ;Process 'File' portion
+75 DO FILE($NAME(@DATA@(INDX,1)),EINDX,AINDX,ERRARR,DOMAIN)
+76 QUIT
+77 ;
FILE(DATA,EINDX,AINDX,ERRARR,DOMAIN) ;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 ; ERRARR - Error array (closed root)
+6 ; DOMAIN - Value of 'DomainName' element
+7 ;Output : None
+8 ; @ERRARR@(x) = Error text (if applicable)
+9 ; Notes : Existance/validity of input assumed (internal call)
+10 NEW INDX,REP,FILE,FIELD,OOPS,EXIST,LASTERR,X,Y,TMP
+11 NEW FACPTR,FACNAME,FACNUM,IPADD,SYSTYPE,FILENAME
+12 SET INDX=@EINDX@("File")
+13 SET REP=0
+14 FOR
SET REP=+$ORDER(@DATA@(INDX,REP))
if 'REP
QUIT
Begin DoDot:1
+15 SET OOPS=0
+16 ;Get elements
+17 SET FILE=$GET(@DATA@(INDX,REP,@EINDX@("FileNumber"),1,"V"))
+18 SET FIELD=$GET(@DATA@(INDX,REP,@EINDX@("FieldNumber"),1,"V"))
+19 ;Validate elements
+20 FOR TMP="FILE","FIELD"
IF $GET(@TMP)=""
Begin DoDot:2
+21 SET Y="FileNumber"
+22 IF TMP="FIELD"
SET Y="FieldNumber"
+23 SET X="XML element '"_TMP_"' did not have a value"
+24 DO ADDERR^HDISVC00(X,ERRARR)
+25 SET OOPS=1
End DoDot:2
+26 ;Errors found - quit
+27 IF OOPS
QUIT
+28 IF '$$VFILE^DILFD(FILE)
Begin DoDot:2
+29 SET TMP="Repetition number "_REP_" of XML element 'FileNumber' "
+30 SET TMP=TMP_"is not a valid file number"
+31 DO ADDERR^HDISVC00(TMP,ERRARR)
+32 SET OOPS=1
End DoDot:2
+33 IF 'OOPS
IF '$$VFIELD^DILFD(FILE,FIELD)
Begin DoDot:2
+34 SET TMP="Repetition number "_REP_" of XML element 'FieldNumber' "
+35 SET TMP=TMP_"is not a valid field number"
+36 DO ADDERR^HDISVC00(TMP,ERRARR)
+37 SET OOPS=1
End DoDot:2
+38 ;Errors found - quit
+39 IF OOPS
QUIT
+40 ;Status update - VUIDs received
+41 SET TMP=$$STATUPD^HDISVCUT(FILE,FIELD,3)
+42 ;Make sure VUID and status fields are defined
+43 IF '$$SETCODE^HDISVC02(FILE,FIELD)
SET EXIST=$$FLDXST(FILE)
IF 'EXIST
Begin DoDot:2
+44 FOR TMP=2:1:4
IF '$PIECE(EXIST,"^",TMP)
Begin DoDot:3
+45 SET X="File number "_FILE_" is missing field number "
+46 IF TMP=2
SET X=X_"99.99 (VUID)"
+47 IF TMP=3
SET X=X_"99.991 (EFFECTIVE DATE multiple)"
+48 IF TMP=4
SET X=X_".02 (STATUS) of EFFECTIVE DATE multiple (99.991)"
+49 DO ADDERR^HDISVC00(X,ERRARR)
+50 IF TMP=3
SET TMP=4
End DoDot:3
+51 SET OOPS=1
End DoDot:2
+52 ;Problem(s) found - don't continue
+53 IF OOPS
Begin DoDot:2
+54 ;Status update (error)
+55 SET TMP=$$STATUPD^HDISVCUT(FILE,FIELD,5)
End DoDot:2
QUIT
+56 ;Remember last error number
+57 SET LASTERR=+$ORDER(@ERRARR@(""),-1)
+58 ;Process 'Term' portion
+59 DO TERM^HDISVC02($NAME(@DATA@(INDX,REP)),EINDX,AINDX,ERRARR,FILE,FIELD)
+60 ;Error(s) added - status update (error)
+61 IF LASTERR'=+$ORDER(@ERRARR@(""),-1)
SET TMP=$$STATUPD^HDISVCUT(FILE,FIELD,5)
QUIT
+62 ;Status update (VUIDs assigned)
+63 SET TMP=$$STATUPD^HDISVCUT(FILE,FIELD,4)
+64 ;Notify ERT that VUID's have been stored
+65 KILL FACPTR,IPADD,SYSTYPE
+66 IF '$$GETFAC^HDISVF07(,.FACPTR)
SET FACPTR=$$FACPTR^HDISVF01()
+67 IF '$$GETDIP^HDISVF07(,.IPADD)
SET IPADD=$GET(^XMB("NETNAME"))
+68 IF '$$GETTYPE^HDISVF07(,,.SYSTYPE)
Begin DoDot:2
+69 SET SYSTYPE=$$PROD^XUPROD()
+70 SET SYSTYPE=$SELECT(SYSTYPE:"PRODUCTION",1:"TEST")
End DoDot:2
+71 SET TMP=$$NS^XUAF4(FACPTR)
+72 SET FACNAME=$PIECE(TMP,"^",1)
+73 SET FACNUM=$PIECE(TMP,"^",2)
+74 IF (FACNAME="")!(FACNUM="")
Begin DoDot:2
+75 SET TMP=$$SITE^VASITE()
+76 SET FACNAME=$PIECE(TMP,"^",2)
+77 SET FACNUM=$PIECE(TMP,"^",3)
End DoDot:2
+78 SET FACNAME=FACNAME_" (#"_FACNUM_") with Domain/IP Address "_IPADD
+79 SET FILENAME=$$GET1^DID(FILE,,,"NAME")
+80 SET FILENAME=FILENAME_" (#"_FILE_")"
+81 DO ERTBULL^HDISVF09(FACNAME,FILENAME,$$NOW^XLFDT(),SYSTYPE,FACNUM,FILE)
End DoDot:1
+82 QUIT
+83 ;
FLDXST(FILE) ;Check for existance of VUID and status fields
+1 ; Input : FILE - File number
+2 ;Output : 1 = Required VUID and status fields exist
+3 ; 0^VUID^Status^StatusDate = One or more fields missing
+4 ; 0 put in piece of missing field
+5 ; Notes : Existance/validity of input assumed (internal call)
+6 NEW VUID,STAT,STDT,OUTPUT,SUBFILE
+7 SET (OUTPUT,VUID,STAT,STDT)=1
+8 ;VUID field
+9 IF '$$VFIELD^DILFD(FILE,99.99)
Begin DoDot:1
+10 SET OUTPUT=0
+11 SET VUID=0
End DoDot:1
+12 ;EFFECTIVE DATE multiple
+13 IF '$$VFIELD^DILFD(FILE,99.991)
Begin DoDot:1
+14 SET OUTPUT=0
+15 SET (STAT,STDT)=0
End DoDot:1
+16 SET SUBFILE=+$$GET1^DID(FILE,99.991,"","SPECIFIER")
+17 IF 'SUBFILE
Begin DoDot:1
+18 SET OUTPUT=0
+19 SET (STAT,STDT)=0
End DoDot:1
+20 ;STATUS sub-field
+21 IF SUBFILE
IF '$$VFIELD^DILFD(SUBFILE,.02)
Begin DoDot:1
+22 SET OUTPUT=0
+23 SET STDT=0
End DoDot:1
+24 IF 'OUTPUT
SET OUTPUT=OUTPUT_"^"_VUID_"^"_STAT_"^"_STDT
+25 QUIT OUTPUT
+26 ;
ELEMENTS ;List of required elements in XML document
+1 ;;Domain
+2 ;;DomainName
+3 ;;Source
+4 ;;MailManDomain
+5 ;;File
+6 ;;FileNumber
+7 ;;FieldNumber
+8 ;;Term
+9 ;;TermName
+10 ;;VUID
+11 ;;NationalTerm
+12 ;;FacilityInternalReference
+13 ;;
