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

HDISVS01.m

Go to the documentation of this file. 
  1. HDISVS01 ;BPFO/JRP - PROCESS RECEIVED XML DATA;12/20/2004
  1.  ;;1.0;HEALTH DATA & INFORMATICS;**1**;Feb 22, 2005
  1.  ;
  1. VUID(PRSARR,ERRARR) ;Process XML data 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 VUID requests disabled - throw error and quit
  1.  I $$GETVFAIL^HDISVF02() D  Q
  1.  .N TMP
  1.  .S TMP="VUID^HDISVS01: Processing of VUID requests by central server"
  1.  .S TMP=TMP_" is currently disabled"
  1.  .D ADDERR^HDISVC00(TMP,ERRARR)
  1.  N EINDX,ESUBS,AINDX,ASUBS,DATA,TMP,FFPTR,DOMPTR,XMLDOC
  1.  N DOMAIN,SOURCE,MAILMAN,INDX,OOPS,SYSPTR,SRCTYPE,FILE,FIELD
  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 FFARR=$NA(^TMP("HDISVS01",$J,"FFARR"))
  1.  S XMLDOC=$NA(^TMP("HDISVS01",$J,"XMLDOC"))
  1.  K @FFARR,@XMLDOC
  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="VUID^HDISVS01: 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="VUID^HDISVS01: 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 'Domain' is the root element
  1.  I $G(@ESUBS@(1))'="Domain" D
  1.  .S TMP="'Domain' 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 'Domain' portion of XML doc
  1.  S INDX=@EINDX@("Domain")
  1.  ;Get elements
  1.  S DOMAIN=$G(@DATA@(INDX,1,@EINDX@("DomainName"),1,"V"))
  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.  ;Validate elements
  1.  F TMP="DOMAIN","SOURCE","MAILMAN","SRCTYPE" I $G(@TMP)="" D
  1.  .S Y="DomainName"
  1.  .I TMP="SOURCE" S Y="Source"
  1.  .I TMP="SRCTYPE" S Y="SourceType"
  1.  .I TMP="MAILMAN" S Y="MailManDomain"
  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.  ;Errors found - quit
  1.  I OOPS Q
  1.  ;Get pointers
  1.  I '$$GETIEN^HDISVF09(DOMAIN,.DOMPTR) D
  1.  .S TMP="Entry for XML element 'DomainName' ("_DOMAIN_") could not be "
  1.  .S TMP=TMP_"found in HDIS DOMAIN file (#7115.1)"
  1.  .D ADDERR^HDISVC00(TMP,ERRARR)
  1.  .S OOPS=1
  1.  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=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=TMP_"be found/created in HDIS PARAMETER file (#7718.29)"
  1.  .D ADDERR^HDISVC00(TMP,ERRARR)
  1.  .S OOPS=1
  1.  ;Processing of VUID requests from specific system disabled
  1.  I 'OOPS I $$GETVFAIL^HDISVF02(SYSPTR) D
  1.  .S TMP="Processing of VUID requests 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.  ;Process 'File' portion
  1.  D FILE($NA(@DATA@(INDX,1)),EINDX,AINDX,SYSPTR,FFARR,ERRARR)
  1.  ;Error - don't continue
  1.  I +$O(@ERRARR@(0)) K @FFARR Q
  1.  ;Build/send return XML document(s)
  1.  S FFPTR=""
  1.  F  S FFPTR=+$O(@FFARR@(FFPTR)) Q:'FFPTR  D
  1.  .S TMP=$$GETFF^HDISVF05(FFPTR,.FILE,.FIELD)
  1.  .K @XMLDOC
  1.  .;Status update (building msg)
  1.  .D ADDSTAT^HDISVF01(FFPTR,SYSPTR,102,2)
  1.  .;Build XML document
  1.  .I $$FILE^HDISVSFX(DOMPTR,SYSPTR,FFPTR,XMLDOC)<1 D  Q
  1.  ..;Error
  1.  ..S TMP="Unable to build XML document containing VUID information for"
  1.  ..S TMP=TMP_" file "_FILE_" (field "_FIELD_") in the "_DOMAIN
  1.  ..S TMP=TMP_" domain to facility "_SOURCE_" ("_MAILMAN_")"
  1.  ..D ADDERR^HDISVC00(TMP,ERRARR)
  1.  ..;Status update (error)
  1.  ..D ADDSTAT^HDISVF01(FFPTR,SYSPTR,104,2)
  1.  .;Send XML document
  1.  .I $$SNDXML^HDISVM02(XMLDOC,1,,SYSPTR)<1 D  Q
  1.  ..;Error
  1.  ..S TMP="Unable to send XML document containing VUID information for"
  1.  ..S TMP=TMP_" file "_FILE_" (field "_FIELD_") in the "_DOMAIN
  1.  ..S TMP=TMP_" domain to facility "_SOURCE_" ("_MAILMAN_")"
  1.  ..D ADDERR^HDISVC00(TMP,ERRARR)
  1.  ..;Status update (error)
  1.  ..D ADDSTAT^HDISVF01(FFPTR,SYSPTR,104,2)
  1.  .;Status update (msg sent)
  1.  .D ADDSTAT^HDISVF01(FFPTR,SYSPTR,103,2)
  1.  K @FFARR,@XMLDOC
  1.  Q
  1.  ;
  1. FILE(DATA,EINDX,AINDX,SYSPTR,FFARR,ERRARR) ;Process 'File' portion of XML document
  1.  ; Input : DATA - Array reference from which the 'File' element
  1.  ;                begins (closed root)
  1.  ;         EINDX - Element index array (closed root)
  1.  ;         AINDX - Attribute index array (closed root)
  1.  ;         SYSPTR - Pointer to HDIS SYSTEM file (#7118.21)
  1.  ;         FFARR - Array to output File/Field values (closed root)
  1.  ;         ERRARR - Error array (closed root)
  1.  ;Output : None
  1.  ;         @FFARR@(Ptr) = ""
  1.  ;            Ptr - Pointer to HDIS FILE/FIELD file (#7115.6)
  1.  ;         @ERRARR@(x) = Error text (if applicable)
  1.  ; Notes : Existance/validity of input assumed (internal call)
  1.  N INDX,REP,FILE,FIELD,OOPS,FFPTR,LASTERR
  1.  S INDX=@EINDX@("File")
  1.  S REP=0
  1.  F  S REP=+$O(@DATA@(INDX,REP)) Q:'REP  D
  1.  .S OOPS=0
  1.  .;Get elements
  1.  .S FILE=$G(@DATA@(INDX,REP,@EINDX@("FileNumber"),1,"V"))
  1.  .S FIELD=$G(@DATA@(INDX,REP,@EINDX@("FieldNumber"),1,"V"))
  1.  .;Validate elements
  1.  .F TMP="FILE","FIELD" I $G(@TMP)="" D
  1.  ..S Y="FileNumber"
  1.  ..I TMP="FIELD" S Y="FieldNumber"
  1.  ..S X="XML element '"_TMP_"' did not have a value"
  1.  ..D ADDERR^HDISVC00(X,ERRARR)
  1.  ..S OOPS=1
  1.  .;Convert file & field to pointer
  1.  .I FILE I FIELD I '$$GETIEN^HDISVF05(FILE,FIELD,.FFPTR) D
  1.  ..S TMP="Values of XML elements 'FileNumber' ("_FILE
  1.  ..S TMP=TMP_") and 'FieldNumber ("_FIELD_") not found in HDIS"
  1.  ..S TMP=TMP_" FILE/FIELD file (#7115.6)"
  1.  ..D ADDERR^HDISVC00(TMP,ERRARR)
  1.  ..S OOPS=1
  1.  .;Problem(s) found - don't continue
  1.  .I OOPS Q
  1.  .;Add File/Field to output array
  1.  .S @FFARR@(FFPTR)=""
  1.  .;Status update (start VUID assign)
  1.  .D ADDSTAT^HDISVF01(FFPTR,SYSPTR,101,2)
  1.  .;Remember last error number
  1.  .S LASTERR=+$O(@ERRARR@(""),-1)
  1.  .;Process 'Term' portion
  1.  .D TERM^HDISVS02($NA(@DATA@(INDX,REP)),EINDX,AINDX,SYSPTR,FFPTR,ERRARR)
  1.  .;Error(s) added - status update (error)
  1.  .I LASTERR'=+$O(@ERRARR@(""),-1) D ADDSTAT^HDISVF01(FFPTR,SYSPTR,104,2)
  1.  Q
  1.  ;
  1. ELEMENTS ;List of required elements in XML document
  1.  ;;Domain
  1.  ;;DomainName
  1.  ;;Source
  1.  ;;SourceType
  1.  ;;MailManDomain
  1.  ;;File
  1.  ;;FileNumber
  1.  ;;FieldNumber
  1.  ;;Term
  1.  ;;TermName
  1.  ;;VUID
  1.  ;;FacilityInternalReference
  1.  ;;