- HDISVC02 ;BPFO/JRP - PROCESS RECEIVED XML DATA;12/20/2004
- ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
- ;
- TERM(DATA,EINDX,AINDX,ERRARR,FILE,FIELD) ;Process 'Term' 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)
- ; FILE - Value of 'FileNumber' element
- ; FIELD - Value of 'FieldNumber' element
- ;Output : None
- ; @ERRARR@(x) = Error text (if applicable)
- ; Notes : Existance/validity of input assumed (internal call)
- N INDX,REP,TERM,IREF,VUID,TMP,OOPS,DATE,NTNL
- S INDX=@EINDX@("Term")
- S REP=0
- F S REP=+$O(@DATA@(INDX,REP)) Q:'REP D
- .S OOPS=0
- .;Get elements
- .S TERM=$G(@DATA@(INDX,REP,@EINDX@("TermName"),1,"V"))
- .S IREF=$G(@DATA@(INDX,REP,@EINDX@("FacilityInternalReference"),1,"V"))
- .S VUID=$G(@DATA@(INDX,REP,@EINDX@("VUID"),1,"V"))
- .S NTNL=$G(@DATA@(INDX,REP,@EINDX@("NationalTerm"),1,"V"))
- .;Validate elements
- .F TMP="TERM","VUID","IREF","NTNL" I $G(@TMP)="" D
- ..S Y="TermName"
- ..I TMP="VUID" S Y="VUID"
- ..I TMP="IREF" S Y="FacilityInternalReference"
- ..I TMP="NTNL" S Y="NationalTerm"
- ..S X="XML element '"_Y_"' for repetition number "_REP_" of 'Term' "
- ..I TMP="TERM" S X="Repetition number "_REP_" of XML element 'Term' "
- ..I TMP'="TERM" S X=X_"("_TERM_") "
- ..S X=X_"did not have a value"
- ..D ADDERR^HDISVC00(X,ERRARR)
- ..S OOPS=1
- .;Problem found - quit
- .I OOPS Q
- .;Does entry exist
- .I '$$EXISTS(FILE,FIELD,IREF) D
- ..S TMP="Value for 'FacilityInternalReference' ("_IREF_") not valid "
- ..S TMP=TMP_"for repetition number "_REP_" of 'Term' ("_TERM_")"
- ..D ADDERR^HDISVC00(TMP,ERRARR)
- ..S OOPS=1
- .;Does received term match stored term
- .I 'OOPS I '$$VALMATCH(FILE,FIELD,IREF,TERM) D
- ..S TMP="Local value does not match received value for repetition "
- ..S TMP=TMP_"number "_REP_" of 'Term' ("_TERM_")"
- ..D ADDERR^HDISVC00(TMP,ERRARR)
- ..S OOPS=1
- .;Is 'NationalTerm; valid value
- .I NTNL'=0 I NTNL'=1 D
- ..S TMP="Value for 'NationalTerm' ("_NTNL_") not valid for "
- ..S TMP=TMP_"repetition number "_REP_" of 'Term' ("_TERM_")"
- ..D ADDERR^HDISVC00(TMP,ERRARR)
- ..S OOPS=1
- .;Problem found - don't continue
- .I OOPS Q
- .;Store/update VUID (inactivates term when appropriate)
- .D STOREIT(FILE,FIELD,IREF,VUID,NTNL,ERRARR)
- Q
- ;
- EXISTS(FILE,FIELD,IREF) ;Does entry exist
- ; Input : FILE - File number
- ; FIELD - Field number
- ; IREF - Internal reference
- ;Output : 1 if entry exists
- ; 0 if entry doesn't exist
- ; Notes : Existance/validity of input assumed (internal call)
- N EXIST,CODES
- S EXIST=0
- S CODES=$$SETCODE(FILE,FIELD)
- ;Set of codes
- I CODES I $$EXTERNAL^DILFD(FILE,FIELD,"",IREF) S EXIST=1
- ;Entry in file
- I 'CODES D
- .S IREF="`"_(+IREF)
- .I $$FIND1^DIC(FILE,"","",IREF) S EXIST=1
- D CLEAN^DILF
- Q EXIST
- ;
- VALMATCH(FILE,FIELD,IREF,VALUE) ;Check input value against stored value
- ; Input : FILE - File number
- ; FIELD - Field number
- ; IREF - Internal reference
- ; VALUE - Value to verify
- ;Output : 1 if stored value equals input VALUE
- ; 0 if stored value does not equal input VALUE
- ; Notes : Existance/validity of input assumed (internal call)
- N MATCH,CODES,LOCVAL
- S MATCH=0
- S CODES=$$SETCODE(FILE,FIELD)
- ;Set of codes
- I CODES S LOCVAL=$$EXTERNAL^DILFD(FILE,FIELD,"",IREF)
- ;Entry in file
- I 'CODES S LOCVAL=$$GET1^DIQ(FILE,IREF,FIELD)
- ;Case insensitive compare
- I $$UP^XLFSTR(LOCVAL)=$$UP^XLFSTR(VALUE) S MATCH=1
- D CLEAN^DILF
- Q MATCH
- ;
- SETCODE(FILE,FIELD) ;Is field a set of codes
- ; Input : FILE - File number
- ; FIELD - Field number
- ;Output : 1 if field is a set of codes
- ; 0 if field is not a set of codes
- ; Notes : Existance/validity of input assumed (internal call)
- N CODES
- S CODES=0
- I $$GET1^DID(FILE,FIELD,"","TYPE")="SET" S CODES=1
- Q CODES
- ;
- STOREIT(FILE,FIELD,IREF,VUID,NTNL,ERRARR) ;Store VUID
- ; Input : FILE - File number
- ; FIELD - Field number
- ; IREF - Internal reference
- ; VUID - VUID
- ; NTNL - National term
- ; 0 = No (default) 1 = Yes
- ; ERRARR - Error array (closed root)
- ;Output : None
- ; @ERRARR@(x) = Error text (if applicable)
- ; Notes : Existance/validity of input assumed (internal call)
- ; : Call will automatically inactivate terms when appropriate
- ;
- N TMP,MASTER
- S NTNL=+$G(NTNL)
- ;Store VUID (also sets master entry flag, if appropriate)
- I '$$SETVUID^XTID(FILE,FIELD,IREF,VUID) D Q
- .S TMP="Unable to store "_VUID_" as the VUID for internal reference '"
- .S TMP=TMP_IREF_"' of field number "_FIELD_" in file number "_FILE
- .D ADDERR^HDISVC00(TMP,ERRARR)
- ;Get master entry flag
- S MASTER=$$GETMASTR^XTID(FILE,FIELD,IREF)
- ;Don't inactivate national terms that are the master entry
- I NTNL I MASTER Q
- ;Inactivate
- I '$$SETSTAT^XTID(FILE,FIELD,IREF,0,$$NOW^XLFDT()) D Q
- .S TMP="Unable to inactivate internal reference "_IREF_" of field "
- .S TMP=TMP_"number "_FIELD_" in file number "_FILE_". VUID for the"
- .S TMP=TMP_" "_$S(NTNL:"",1:"non-")_"standard term was "_VUID_"."
- .D ADDERR^HDISVC00(TMP,ERRARR)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISVC02 5364 printed Jan 18, 2025@02:57:54 Page 2
- HDISVC02 ;BPFO/JRP - PROCESS RECEIVED XML DATA;12/20/2004
- +1 ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
- +2 ;
- TERM(DATA,EINDX,AINDX,ERRARR,FILE,FIELD) ;Process 'Term' 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 ; FILE - Value of 'FileNumber' element
- +7 ; FIELD - Value of 'FieldNumber' element
- +8 ;Output : None
- +9 ; @ERRARR@(x) = Error text (if applicable)
- +10 ; Notes : Existance/validity of input assumed (internal call)
- +11 NEW INDX,REP,TERM,IREF,VUID,TMP,OOPS,DATE,NTNL
- +12 SET INDX=@EINDX@("Term")
- +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 TERM=$GET(@DATA@(INDX,REP,@EINDX@("TermName"),1,"V"))
- +18 SET IREF=$GET(@DATA@(INDX,REP,@EINDX@("FacilityInternalReference"),1,"V"))
- +19 SET VUID=$GET(@DATA@(INDX,REP,@EINDX@("VUID"),1,"V"))
- +20 SET NTNL=$GET(@DATA@(INDX,REP,@EINDX@("NationalTerm"),1,"V"))
- +21 ;Validate elements
- +22 FOR TMP="TERM","VUID","IREF","NTNL"
- IF $GET(@TMP)=""
- Begin DoDot:2
- +23 SET Y="TermName"
- +24 IF TMP="VUID"
- SET Y="VUID"
- +25 IF TMP="IREF"
- SET Y="FacilityInternalReference"
- +26 IF TMP="NTNL"
- SET Y="NationalTerm"
- +27 SET X="XML element '"_Y_"' for repetition number "_REP_" of 'Term' "
- +28 IF TMP="TERM"
- SET X="Repetition number "_REP_" of XML element 'Term' "
- +29 IF TMP'="TERM"
- SET X=X_"("_TERM_") "
- +30 SET X=X_"did not have a value"
- +31 DO ADDERR^HDISVC00(X,ERRARR)
- +32 SET OOPS=1
- End DoDot:2
- +33 ;Problem found - quit
- +34 IF OOPS
- QUIT
- +35 ;Does entry exist
- +36 IF '$$EXISTS(FILE,FIELD,IREF)
- Begin DoDot:2
- +37 SET TMP="Value for 'FacilityInternalReference' ("_IREF_") not valid "
- +38 SET TMP=TMP_"for repetition number "_REP_" of 'Term' ("_TERM_")"
- +39 DO ADDERR^HDISVC00(TMP,ERRARR)
- +40 SET OOPS=1
- End DoDot:2
- +41 ;Does received term match stored term
- +42 IF 'OOPS
- IF '$$VALMATCH(FILE,FIELD,IREF,TERM)
- Begin DoDot:2
- +43 SET TMP="Local value does not match received value for repetition "
- +44 SET TMP=TMP_"number "_REP_" of 'Term' ("_TERM_")"
- +45 DO ADDERR^HDISVC00(TMP,ERRARR)
- +46 SET OOPS=1
- End DoDot:2
- +47 ;Is 'NationalTerm; valid value
- +48 IF NTNL'=0
- IF NTNL'=1
- Begin DoDot:2
- +49 SET TMP="Value for 'NationalTerm' ("_NTNL_") not valid for "
- +50 SET TMP=TMP_"repetition number "_REP_" of 'Term' ("_TERM_")"
- +51 DO ADDERR^HDISVC00(TMP,ERRARR)
- +52 SET OOPS=1
- End DoDot:2
- +53 ;Problem found - don't continue
- +54 IF OOPS
- QUIT
- +55 ;Store/update VUID (inactivates term when appropriate)
- +56 DO STOREIT(FILE,FIELD,IREF,VUID,NTNL,ERRARR)
- End DoDot:1
- +57 QUIT
- +58 ;
- EXISTS(FILE,FIELD,IREF) ;Does entry exist
- +1 ; Input : FILE - File number
- +2 ; FIELD - Field number
- +3 ; IREF - Internal reference
- +4 ;Output : 1 if entry exists
- +5 ; 0 if entry doesn't exist
- +6 ; Notes : Existance/validity of input assumed (internal call)
- +7 NEW EXIST,CODES
- +8 SET EXIST=0
- +9 SET CODES=$$SETCODE(FILE,FIELD)
- +10 ;Set of codes
- +11 IF CODES
- IF $$EXTERNAL^DILFD(FILE,FIELD,"",IREF)
- SET EXIST=1
- +12 ;Entry in file
- +13 IF 'CODES
- Begin DoDot:1
- +14 SET IREF="`"_(+IREF)
- +15 IF $$FIND1^DIC(FILE,"","",IREF)
- SET EXIST=1
- End DoDot:1
- +16 DO CLEAN^DILF
- +17 QUIT EXIST
- +18 ;
- VALMATCH(FILE,FIELD,IREF,VALUE) ;Check input value against stored value
- +1 ; Input : FILE - File number
- +2 ; FIELD - Field number
- +3 ; IREF - Internal reference
- +4 ; VALUE - Value to verify
- +5 ;Output : 1 if stored value equals input VALUE
- +6 ; 0 if stored value does not equal input VALUE
- +7 ; Notes : Existance/validity of input assumed (internal call)
- +8 NEW MATCH,CODES,LOCVAL
- +9 SET MATCH=0
- +10 SET CODES=$$SETCODE(FILE,FIELD)
- +11 ;Set of codes
- +12 IF CODES
- SET LOCVAL=$$EXTERNAL^DILFD(FILE,FIELD,"",IREF)
- +13 ;Entry in file
- +14 IF 'CODES
- SET LOCVAL=$$GET1^DIQ(FILE,IREF,FIELD)
- +15 ;Case insensitive compare
- +16 IF $$UP^XLFSTR(LOCVAL)=$$UP^XLFSTR(VALUE)
- SET MATCH=1
- +17 DO CLEAN^DILF
- +18 QUIT MATCH
- +19 ;
- SETCODE(FILE,FIELD) ;Is field a set of codes
- +1 ; Input : FILE - File number
- +2 ; FIELD - Field number
- +3 ;Output : 1 if field is a set of codes
- +4 ; 0 if field is not a set of codes
- +5 ; Notes : Existance/validity of input assumed (internal call)
- +6 NEW CODES
- +7 SET CODES=0
- +8 IF $$GET1^DID(FILE,FIELD,"","TYPE")="SET"
- SET CODES=1
- +9 QUIT CODES
- +10 ;
- STOREIT(FILE,FIELD,IREF,VUID,NTNL,ERRARR) ;Store VUID
- +1 ; Input : FILE - File number
- +2 ; FIELD - Field number
- +3 ; IREF - Internal reference
- +4 ; VUID - VUID
- +5 ; NTNL - National term
- +6 ; 0 = No (default) 1 = Yes
- +7 ; ERRARR - Error array (closed root)
- +8 ;Output : None
- +9 ; @ERRARR@(x) = Error text (if applicable)
- +10 ; Notes : Existance/validity of input assumed (internal call)
- +11 ; : Call will automatically inactivate terms when appropriate
- +12 ;
- +13 NEW TMP,MASTER
- +14 SET NTNL=+$GET(NTNL)
- +15 ;Store VUID (also sets master entry flag, if appropriate)
- +16 IF '$$SETVUID^XTID(FILE,FIELD,IREF,VUID)
- Begin DoDot:1
- +17 SET TMP="Unable to store "_VUID_" as the VUID for internal reference '"
- +18 SET TMP=TMP_IREF_"' of field number "_FIELD_" in file number "_FILE
- +19 DO ADDERR^HDISVC00(TMP,ERRARR)
- End DoDot:1
- QUIT
- +20 ;Get master entry flag
- +21 SET MASTER=$$GETMASTR^XTID(FILE,FIELD,IREF)
- +22 ;Don't inactivate national terms that are the master entry
- +23 IF NTNL
- IF MASTER
- QUIT
- +24 ;Inactivate
- +25 IF '$$SETSTAT^XTID(FILE,FIELD,IREF,0,$$NOW^XLFDT())
- Begin DoDot:1
- +26 SET TMP="Unable to inactivate internal reference "_IREF_" of field "
- +27 SET TMP=TMP_"number "_FIELD_" in file number "_FILE_". VUID for the"
- +28 SET TMP=TMP_" "_$SELECT(NTNL:"",1:"non-")_"standard term was "_VUID_"."
- +29 DO ADDERR^HDISVC00(TMP,ERRARR)
- End DoDot:1
- QUIT
- +30 QUIT