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