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

HDISVC01.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. DOMAIN(PRSARR,ERRARR) ;Process XML data from VUID Server
  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 VUID data disabled - throw error and quit
  1.  I $$GETVFAIL^HDISVF02() D  Q
  1.  .N TMP
  1.  .S TMP="DOMAIN^HDISVC01: Processing of VUID data from central server"
  1.  .S TMP=TMP_" is currently disabled"
  1.  .D ADDERR^HDISVC00(TMP,ERRARR)
  1.  N EINDX,ESUBS,AINDX,ASUBS,DATA,TMP,X,Y
  1.  N DOMAIN,SOURCE,MAILMAN,INDX,OOPS
  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 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="DOMAIN^HDISVC01: 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="DOMAIN^HDISVC01: 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 MAILMAN=$G(@DATA@(INDX,1,@EINDX@("MailManDomain"),1,"V"))
  1.  ;Validate elements
  1.  F TMP="DOMAIN","SOURCE","MAILMAN" I $G(@TMP)="" D
  1.  .S Y="DomainName"
  1.  .I TMP="SOURCE" S Y="Source"
  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.  ;Ensure that 'Source' matches local number
  1.  I SOURCE'="" I SOURCE'=$$FACNUM^HDISVF01() D
  1.  .S TMP="Value of XML element 'Source' ("_SOURCE
  1.  .S TMP=TMP_") does not match local facility number"
  1.  .D ADDERR^HDISVC00(TMP,ERRARR)
  1.  .S OOPS=1
  1.  ;Ensure that 'MailManDomain' matches local domain
  1.  I MAILMAN'="" I MAILMAN'=$G(^XMB("NETNAME")) D
  1.  .S TMP="Value of XML element 'MailManDomain' ("_MAILMAN
  1.  .S TMP=TMP_") does not match local domain"
  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,ERRARR,DOMAIN)
  1.  Q
  1.  ;
  1. FILE(DATA,EINDX,AINDX,ERRARR,DOMAIN) ;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.  ;         ERRARR - Error array (closed root)
  1.  ;         DOMAIN - Value of 'DomainName' element
  1.  ;Output : None
  1.  ;         @ERRARR@(x) = Error text (if applicable)
  1.  ; Notes : Existance/validity of input assumed (internal call)
  1.  N INDX,REP,FILE,FIELD,OOPS,EXIST,LASTERR,X,Y,TMP
  1.  N FACPTR,FACNAME,FACNUM,IPADD,SYSTYPE,FILENAME
  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.  .;Errors found - quit
  1.  .I OOPS Q
  1.  .I '$$VFILE^DILFD(FILE) D
  1.  ..S TMP="Repetition number "_REP_" of XML element 'FileNumber' "
  1.  ..S TMP=TMP_"is not a valid file number"
  1.  ..D ADDERR^HDISVC00(TMP,ERRARR)
  1.  ..S OOPS=1
  1.  .I 'OOPS I '$$VFIELD^DILFD(FILE,FIELD) D
  1.  ..S TMP="Repetition number "_REP_" of XML element 'FieldNumber' "
  1.  ..S TMP=TMP_"is not a valid field number"
  1.  ..D ADDERR^HDISVC00(TMP,ERRARR)
  1.  ..S OOPS=1
  1.  .;Errors found - quit
  1.  .I OOPS Q
  1.  .;Status update - VUIDs received
  1.  .S TMP=$$STATUPD^HDISVCUT(FILE,FIELD,3)
  1.  .;Make sure VUID and status fields are defined
  1.  .I '$$SETCODE^HDISVC02(FILE,FIELD) S EXIST=$$FLDXST(FILE) I 'EXIST D
  1.  ..F TMP=2:1:4 I '$P(EXIST,"^",TMP) D
  1.  ...S X="File number "_FILE_" is missing field number "
  1.  ...I TMP=2 S X=X_"99.99 (VUID)"
  1.  ...I TMP=3 S X=X_"99.991 (EFFECTIVE DATE multiple)"
  1.  ...I TMP=4 S X=X_".02 (STATUS) of EFFECTIVE DATE multiple (99.991)"
  1.  ...D ADDERR^HDISVC00(X,ERRARR)
  1.  ...I TMP=3 S TMP=4
  1.  ..S OOPS=1
  1.  .;Problem(s) found - don't continue
  1.  .I OOPS D  Q
  1.  ..;Status update (error)
  1.  ..S TMP=$$STATUPD^HDISVCUT(FILE,FIELD,5)
  1.  .;Remember last error number
  1.  .S LASTERR=+$O(@ERRARR@(""),-1)
  1.  .;Process 'Term' portion
  1.  .D TERM^HDISVC02($NA(@DATA@(INDX,REP)),EINDX,AINDX,ERRARR,FILE,FIELD)
  1.  .;Error(s) added - status update (error)
  1.  .I LASTERR'=+$O(@ERRARR@(""),-1) S TMP=$$STATUPD^HDISVCUT(FILE,FIELD,5) Q
  1.  .;Status update (VUIDs assigned)
  1.  .S TMP=$$STATUPD^HDISVCUT(FILE,FIELD,4)
  1.  .;Notify ERT that VUID's have been stored
  1.  .K FACPTR,IPADD,SYSTYPE
  1.  .I '$$GETFAC^HDISVF07(,.FACPTR) S FACPTR=$$FACPTR^HDISVF01()
  1.  .I '$$GETDIP^HDISVF07(,.IPADD) S IPADD=$G(^XMB("NETNAME"))
  1.  .I '$$GETTYPE^HDISVF07(,,.SYSTYPE) D
  1.  ..S SYSTYPE=$$PROD^XUPROD()
  1.  ..S SYSTYPE=$S(SYSTYPE:"PRODUCTION",1:"TEST")
  1.  .S TMP=$$NS^XUAF4(FACPTR)
  1.  .S FACNAME=$P(TMP,"^",1)
  1.  .S FACNUM=$P(TMP,"^",2)
  1.  .I (FACNAME="")!(FACNUM="") D
  1.  ..S TMP=$$SITE^VASITE()
  1.  ..S FACNAME=$P(TMP,"^",2)
  1.  ..S FACNUM=$P(TMP,"^",3)
  1.  .S FACNAME=FACNAME_" (#"_FACNUM_") with Domain/IP Address "_IPADD
  1.  .S FILENAME=$$GET1^DID(FILE,,,"NAME")
  1.  .S FILENAME=FILENAME_" (#"_FILE_")"
  1.  .D ERTBULL^HDISVF09(FACNAME,FILENAME,$$NOW^XLFDT(),SYSTYPE,FACNUM,FILE)
  1.  Q
  1.  ;
  1. FLDXST(FILE) ;Check for existance of VUID and status fields
  1.  ; Input : FILE - File number
  1.  ;Output : 1 = Required VUID and status fields exist
  1.  ;         0^VUID^Status^StatusDate = One or more fields missing
  1.  ;                                    0 put in piece of missing field
  1.  ; Notes : Existance/validity of input assumed (internal call)
  1.  N VUID,STAT,STDT,OUTPUT,SUBFILE
  1.  S (OUTPUT,VUID,STAT,STDT)=1
  1.  ;VUID field
  1.  I '$$VFIELD^DILFD(FILE,99.99) D
  1.  .S OUTPUT=0
  1.  .S VUID=0
  1.  ;EFFECTIVE DATE multiple
  1.  I '$$VFIELD^DILFD(FILE,99.991) D
  1.  .S OUTPUT=0
  1.  .S (STAT,STDT)=0
  1.  S SUBFILE=+$$GET1^DID(FILE,99.991,"","SPECIFIER")
  1.  I 'SUBFILE D
  1.  .S OUTPUT=0
  1.  .S (STAT,STDT)=0
  1.  ;STATUS sub-field
  1.  I SUBFILE I '$$VFIELD^DILFD(SUBFILE,.02) D
  1.  .S OUTPUT=0
  1.  .S STDT=0
  1.  I 'OUTPUT S OUTPUT=OUTPUT_"^"_VUID_"^"_STAT_"^"_STDT
  1.  Q OUTPUT
  1.  ;
  1. ELEMENTS ;List of required elements in XML document
  1.  ;;Domain
  1.  ;;DomainName
  1.  ;;Source
  1.  ;;MailManDomain
  1.  ;;File
  1.  ;;FileNumber
  1.  ;;FieldNumber
  1.  ;;Term
  1.  ;;TermName
  1.  ;;VUID
  1.  ;;NationalTerm
  1.  ;;FacilityInternalReference
  1.  ;;