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

HDISVC02.m

Go to the documentation of this file.
  1. HDISVC02 ;BPFO/JRP - PROCESS RECEIVED XML DATA;12/20/2004
  1. ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
  1. ;
  1. TERM(DATA,EINDX,AINDX,ERRARR,FILE,FIELD) ;Process 'Term' 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. ; FILE - Value of 'FileNumber' element
  1. ; FIELD - Value of 'FieldNumber' element
  1. ;Output : None
  1. ; @ERRARR@(x) = Error text (if applicable)
  1. ; Notes : Existance/validity of input assumed (internal call)
  1. N INDX,REP,TERM,IREF,VUID,TMP,OOPS,DATE,NTNL
  1. S INDX=@EINDX@("Term")
  1. S REP=0
  1. F S REP=+$O(@DATA@(INDX,REP)) Q:'REP D
  1. .S OOPS=0
  1. .;Get elements
  1. .S TERM=$G(@DATA@(INDX,REP,@EINDX@("TermName"),1,"V"))
  1. .S IREF=$G(@DATA@(INDX,REP,@EINDX@("FacilityInternalReference"),1,"V"))
  1. .S VUID=$G(@DATA@(INDX,REP,@EINDX@("VUID"),1,"V"))
  1. .S NTNL=$G(@DATA@(INDX,REP,@EINDX@("NationalTerm"),1,"V"))
  1. .;Validate elements
  1. .F TMP="TERM","VUID","IREF","NTNL" I $G(@TMP)="" D
  1. ..S Y="TermName"
  1. ..I TMP="VUID" S Y="VUID"
  1. ..I TMP="IREF" S Y="FacilityInternalReference"
  1. ..I TMP="NTNL" S Y="NationalTerm"
  1. ..S X="XML element '"_Y_"' for repetition number "_REP_" of 'Term' "
  1. ..I TMP="TERM" S X="Repetition number "_REP_" of XML element 'Term' "
  1. ..I TMP'="TERM" S X=X_"("_TERM_") "
  1. ..S X=X_"did not have a value"
  1. ..D ADDERR^HDISVC00(X,ERRARR)
  1. ..S OOPS=1
  1. .;Problem found - quit
  1. .I OOPS Q
  1. .;Does entry exist
  1. .I '$$EXISTS(FILE,FIELD,IREF) D
  1. ..S TMP="Value for 'FacilityInternalReference' ("_IREF_") not valid "
  1. ..S TMP=TMP_"for repetition number "_REP_" of 'Term' ("_TERM_")"
  1. ..D ADDERR^HDISVC00(TMP,ERRARR)
  1. ..S OOPS=1
  1. .;Does received term match stored term
  1. .I 'OOPS I '$$VALMATCH(FILE,FIELD,IREF,TERM) D
  1. ..S TMP="Local value does not match received value for repetition "
  1. ..S TMP=TMP_"number "_REP_" of 'Term' ("_TERM_")"
  1. ..D ADDERR^HDISVC00(TMP,ERRARR)
  1. ..S OOPS=1
  1. .;Is 'NationalTerm; valid value
  1. .I NTNL'=0 I NTNL'=1 D
  1. ..S TMP="Value for 'NationalTerm' ("_NTNL_") not valid for "
  1. ..S TMP=TMP_"repetition number "_REP_" of 'Term' ("_TERM_")"
  1. ..D ADDERR^HDISVC00(TMP,ERRARR)
  1. ..S OOPS=1
  1. .;Problem found - don't continue
  1. .I OOPS Q
  1. .;Store/update VUID (inactivates term when appropriate)
  1. .D STOREIT(FILE,FIELD,IREF,VUID,NTNL,ERRARR)
  1. Q
  1. ;
  1. EXISTS(FILE,FIELD,IREF) ;Does entry exist
  1. ; Input : FILE - File number
  1. ; FIELD - Field number
  1. ; IREF - Internal reference
  1. ;Output : 1 if entry exists
  1. ; 0 if entry doesn't exist
  1. ; Notes : Existance/validity of input assumed (internal call)
  1. N EXIST,CODES
  1. S EXIST=0
  1. S CODES=$$SETCODE(FILE,FIELD)
  1. ;Set of codes
  1. I CODES I $$EXTERNAL^DILFD(FILE,FIELD,"",IREF) S EXIST=1
  1. ;Entry in file
  1. I 'CODES D
  1. .S IREF="`"_(+IREF)
  1. .I $$FIND1^DIC(FILE,"","",IREF) S EXIST=1
  1. D CLEAN^DILF
  1. Q EXIST
  1. ;
  1. VALMATCH(FILE,FIELD,IREF,VALUE) ;Check input value against stored value
  1. ; Input : FILE - File number
  1. ; FIELD - Field number
  1. ; IREF - Internal reference
  1. ; VALUE - Value to verify
  1. ;Output : 1 if stored value equals input VALUE
  1. ; 0 if stored value does not equal input VALUE
  1. ; Notes : Existance/validity of input assumed (internal call)
  1. N MATCH,CODES,LOCVAL
  1. S MATCH=0
  1. S CODES=$$SETCODE(FILE,FIELD)
  1. ;Set of codes
  1. I CODES S LOCVAL=$$EXTERNAL^DILFD(FILE,FIELD,"",IREF)
  1. ;Entry in file
  1. I 'CODES S LOCVAL=$$GET1^DIQ(FILE,IREF,FIELD)
  1. ;Case insensitive compare
  1. I $$UP^XLFSTR(LOCVAL)=$$UP^XLFSTR(VALUE) S MATCH=1
  1. D CLEAN^DILF
  1. Q MATCH
  1. ;
  1. SETCODE(FILE,FIELD) ;Is field a set of codes
  1. ; Input : FILE - File number
  1. ; FIELD - Field number
  1. ;Output : 1 if field is a set of codes
  1. ; 0 if field is not a set of codes
  1. ; Notes : Existance/validity of input assumed (internal call)
  1. N CODES
  1. S CODES=0
  1. I $$GET1^DID(FILE,FIELD,"","TYPE")="SET" S CODES=1
  1. Q CODES
  1. ;
  1. STOREIT(FILE,FIELD,IREF,VUID,NTNL,ERRARR) ;Store VUID
  1. ; Input : FILE - File number
  1. ; FIELD - Field number
  1. ; IREF - Internal reference
  1. ; VUID - VUID
  1. ; NTNL - National term
  1. ; 0 = No (default) 1 = Yes
  1. ; ERRARR - Error array (closed root)
  1. ;Output : None
  1. ; @ERRARR@(x) = Error text (if applicable)
  1. ; Notes : Existance/validity of input assumed (internal call)
  1. ; : Call will automatically inactivate terms when appropriate
  1. ;
  1. N TMP,MASTER
  1. S NTNL=+$G(NTNL)
  1. ;Store VUID (also sets master entry flag, if appropriate)
  1. I '$$SETVUID^XTID(FILE,FIELD,IREF,VUID) D Q
  1. .S TMP="Unable to store "_VUID_" as the VUID for internal reference '"
  1. .S TMP=TMP_IREF_"' of field number "_FIELD_" in file number "_FILE
  1. .D ADDERR^HDISVC00(TMP,ERRARR)
  1. ;Get master entry flag
  1. S MASTER=$$GETMASTR^XTID(FILE,FIELD,IREF)
  1. ;Don't inactivate national terms that are the master entry
  1. I NTNL I MASTER Q
  1. ;Inactivate
  1. I '$$SETSTAT^XTID(FILE,FIELD,IREF,0,$$NOW^XLFDT()) D Q
  1. .S TMP="Unable to inactivate internal reference "_IREF_" of field "
  1. .S TMP=TMP_"number "_FIELD_" in file number "_FILE_". VUID for the"
  1. .S TMP=TMP_" "_$S(NTNL:"",1:"non-")_"standard term was "_VUID_"."
  1. .D ADDERR^HDISVC00(TMP,ERRARR)
  1. Q