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 Dec 13, 2024@01:56:41 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
