source: WorldVistAEHR/trunk/r/HEALTH_DATA_AND_INFORMATICS-HDI/HDISVC02.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.1 KB
Line 
1HDISVC02 ;BPFO/JRP - PROCESS RECEIVED XML DATA;12/20/2004
2 ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
3 ;
4TERM(DATA,EINDX,AINDX,ERRARR,FILE,FIELD) ;Process 'Term' portion of XML document
5 ; Input : DATA - Array reference from which the 'File' element
6 ; begins (closed root)
7 ; EINDX - Element index array (closed root)
8 ; AINDX - Attribute index array (closed root)
9 ; ERRARR - Error array (closed root)
10 ; FILE - Value of 'FileNumber' element
11 ; FIELD - Value of 'FieldNumber' element
12 ;Output : None
13 ; @ERRARR@(x) = Error text (if applicable)
14 ; Notes : Existance/validity of input assumed (internal call)
15 N INDX,REP,TERM,IREF,VUID,TMP,OOPS,DATE,NTNL
16 S INDX=@EINDX@("Term")
17 S REP=0
18 F S REP=+$O(@DATA@(INDX,REP)) Q:'REP D
19 .S OOPS=0
20 .;Get elements
21 .S TERM=$G(@DATA@(INDX,REP,@EINDX@("TermName"),1,"V"))
22 .S IREF=$G(@DATA@(INDX,REP,@EINDX@("FacilityInternalReference"),1,"V"))
23 .S VUID=$G(@DATA@(INDX,REP,@EINDX@("VUID"),1,"V"))
24 .S NTNL=$G(@DATA@(INDX,REP,@EINDX@("NationalTerm"),1,"V"))
25 .;Validate elements
26 .F TMP="TERM","VUID","IREF","NTNL" I $G(@TMP)="" D
27 ..S Y="TermName"
28 ..I TMP="VUID" S Y="VUID"
29 ..I TMP="IREF" S Y="FacilityInternalReference"
30 ..I TMP="NTNL" S Y="NationalTerm"
31 ..S X="XML element '"_Y_"' for repetition number "_REP_" of 'Term' "
32 ..I TMP="TERM" S X="Repetition number "_REP_" of XML element 'Term' "
33 ..I TMP'="TERM" S X=X_"("_TERM_") "
34 ..S X=X_"did not have a value"
35 ..D ADDERR^HDISVC00(X,ERRARR)
36 ..S OOPS=1
37 .;Problem found - quit
38 .I OOPS Q
39 .;Does entry exist
40 .I '$$EXISTS(FILE,FIELD,IREF) D
41 ..S TMP="Value for 'FacilityInternalReference' ("_IREF_") not valid "
42 ..S TMP=TMP_"for repetition number "_REP_" of 'Term' ("_TERM_")"
43 ..D ADDERR^HDISVC00(TMP,ERRARR)
44 ..S OOPS=1
45 .;Does received term match stored term
46 .I 'OOPS I '$$VALMATCH(FILE,FIELD,IREF,TERM) D
47 ..S TMP="Local value does not match received value for repetition "
48 ..S TMP=TMP_"number "_REP_" of 'Term' ("_TERM_")"
49 ..D ADDERR^HDISVC00(TMP,ERRARR)
50 ..S OOPS=1
51 .;Is 'NationalTerm; valid value
52 .I NTNL'=0 I NTNL'=1 D
53 ..S TMP="Value for 'NationalTerm' ("_NTNL_") not valid for "
54 ..S TMP=TMP_"repetition number "_REP_" of 'Term' ("_TERM_")"
55 ..D ADDERR^HDISVC00(TMP,ERRARR)
56 ..S OOPS=1
57 .;Problem found - don't continue
58 .I OOPS Q
59 .;Store/update VUID (inactivates term when appropriate)
60 .D STOREIT(FILE,FIELD,IREF,VUID,NTNL,ERRARR)
61 Q
62 ;
63EXISTS(FILE,FIELD,IREF) ;Does entry exist
64 ; Input : FILE - File number
65 ; FIELD - Field number
66 ; IREF - Internal reference
67 ;Output : 1 if entry exists
68 ; 0 if entry doesn't exist
69 ; Notes : Existance/validity of input assumed (internal call)
70 N EXIST,CODES
71 S EXIST=0
72 S CODES=$$SETCODE(FILE,FIELD)
73 ;Set of codes
74 I CODES I $$EXTERNAL^DILFD(FILE,FIELD,"",IREF) S EXIST=1
75 ;Entry in file
76 I 'CODES D
77 .S IREF="`"_(+IREF)
78 .I $$FIND1^DIC(FILE,"","",IREF) S EXIST=1
79 D CLEAN^DILF
80 Q EXIST
81 ;
82VALMATCH(FILE,FIELD,IREF,VALUE) ;Check input value against stored value
83 ; Input : FILE - File number
84 ; FIELD - Field number
85 ; IREF - Internal reference
86 ; VALUE - Value to verify
87 ;Output : 1 if stored value equals input VALUE
88 ; 0 if stored value does not equal input VALUE
89 ; Notes : Existance/validity of input assumed (internal call)
90 N MATCH,CODES,LOCVAL
91 S MATCH=0
92 S CODES=$$SETCODE(FILE,FIELD)
93 ;Set of codes
94 I CODES S LOCVAL=$$EXTERNAL^DILFD(FILE,FIELD,"",IREF)
95 ;Entry in file
96 I 'CODES S LOCVAL=$$GET1^DIQ(FILE,IREF,FIELD)
97 ;Case insensitive compare
98 I $$UP^XLFSTR(LOCVAL)=$$UP^XLFSTR(VALUE) S MATCH=1
99 D CLEAN^DILF
100 Q MATCH
101 ;
102SETCODE(FILE,FIELD) ;Is field a set of codes
103 ; Input : FILE - File number
104 ; FIELD - Field number
105 ;Output : 1 if field is a set of codes
106 ; 0 if field is not a set of codes
107 ; Notes : Existance/validity of input assumed (internal call)
108 N CODES
109 S CODES=0
110 I $$GET1^DID(FILE,FIELD,"","TYPE")="SET" S CODES=1
111 Q CODES
112 ;
113STOREIT(FILE,FIELD,IREF,VUID,NTNL,ERRARR) ;Store VUID
114 ; Input : FILE - File number
115 ; FIELD - Field number
116 ; IREF - Internal reference
117 ; VUID - VUID
118 ; NTNL - National term
119 ; 0 = No (default) 1 = Yes
120 ; ERRARR - Error array (closed root)
121 ;Output : None
122 ; @ERRARR@(x) = Error text (if applicable)
123 ; Notes : Existance/validity of input assumed (internal call)
124 ; : Call will automatically inactivate terms when appropriate
125 ;
126 N TMP,MASTER
127 S NTNL=+$G(NTNL)
128 ;Store VUID (also sets master entry flag, if appropriate)
129 I '$$SETVUID^XTID(FILE,FIELD,IREF,VUID) D Q
130 .S TMP="Unable to store "_VUID_" as the VUID for internal reference '"
131 .S TMP=TMP_IREF_"' of field number "_FIELD_" in file number "_FILE
132 .D ADDERR^HDISVC00(TMP,ERRARR)
133 ;Get master entry flag
134 S MASTER=$$GETMASTR^XTID(FILE,FIELD,IREF)
135 ;Don't inactivate national terms that are the master entry
136 I NTNL I MASTER Q
137 ;Inactivate
138 I '$$SETSTAT^XTID(FILE,FIELD,IREF,0,$$NOW^XLFDT()) D Q
139 .S TMP="Unable to inactivate internal reference "_IREF_" of field "
140 .S TMP=TMP_"number "_FIELD_" in file number "_FILE_". VUID for the"
141 .S TMP=TMP_" "_$S(NTNL:"",1:"non-")_"standard term was "_VUID_"."
142 .D ADDERR^HDISVC00(TMP,ERRARR)
143 Q
Note: See TracBrowser for help on using the repository browser.