source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLEMU.m@ 1006

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

initial load of WorldVistAEHR

File size: 9.0 KB
Line 
1HLEMU ;ALB/CJM Utility Routines ;02/04/2004 14:42
2 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
3 ;
4STATNUM(IEN) ;
5 ;Description: Given an ien to the Institution file, returns as the function value the station number. If IEN is NOT passed in, it assumes the local site. Returns "" on failure.
6 ;
7 N STATION,RETURN
8 S RETURN=""
9 I $G(IEN) D
10 .Q:'$D(^DIC(4,IEN,0))
11 .S STATION=$P($$NNT^XUAF4(IEN),"^",2)
12 .S RETURN=$S(+STATION:STATION,1:"")
13 E D
14 .S RETURN=$P($$SITE^VASITE(),"^",3)
15 Q RETURN
16INSTIEN(STATION) ;
17 ;Given the station number, this returns a pointer to the Institution file
18 Q $$LKUP^XUAF4(STATION)
19 ;
20UPD(FILE,HLDA,DATA,ERROR) ;File data into an existing record.
21 ; Input:
22 ; FILE - File or sub-file number
23 ; HLDA - New name for traditional DA array, with same meaning.
24 ; Pass by reference.
25 ; DATA - Data array to file (pass by reference)
26 ; Format: DATA(<field #>)=<value>
27 ;
28 ; Output:
29 ; Function Value - 0=error and 1=no error
30 ; ERROR - optional error message - if needed, pass by reference
31 ;
32 ; Example: To update a record in subfile 2.0361 in record with ien=353,
33 ; subrecord ien=68, with the field .01 value = 21:
34 ; S DATA(.01)=21,HLDA=68,HLDA(1)=353 I $$UPD^HLEMU(2.0361,.HLDA,.DATA,.ERROR) W !,"DONE"
35 ;
36 N FDA,FIELD,IENS,ERRORS
37 ;
38 ;IENS - Internal Entry Number String defined by FM
39 ;FDA - the FDA array as defined by FM
40 ;
41 I '$G(HLDA) S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED" Q 0
42 S IENS=$$IENS^DILF(.HLDA)
43 S FIELD=0
44 F S FIELD=$O(DATA(FIELD)) Q:'FIELD D
45 .S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
46 D FILE^HLDIE(,"FDA","ERRORS(1)","UPD","HLEMU")
47 I +$G(DIERR) D
48 .S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
49 E D
50 .S ERROR=""
51 ;
52 I $S(+$G(DIERR):0,1:1) D CLEAN^DILF Q 1
53 E D CLEAN^DILF Q 0
54 ;
55GETFIELD(FILE,FIELD,HLDA,ERROR,EXT) ;Get field value from an existing record.
56 ; Input:
57 ; FILE - File or sub-file number
58 ; HLDA - New name for traditional DA array, with same meaning.
59 ; Pass by reference.
60 ; FIELD - Field for which value is needed
61 ; EXT - (optional) If $G(EXT) then returns the external display form of the value
62 ; Output:
63 ; Function Value - field value in internal format,"" if an error was encountered
64 ; ERROR - optional error message - if needed, pass by reference
65 ;
66 N FDA,IENS,ERRORS,VALUE
67 ;
68 ;IENS - Internal Entry Number String defined by FM
69 ;FDA - the FDA array as defined by FM
70 ;
71 I '$G(HLDA) S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED" Q ""
72 S IENS=$$IENS^DILF(.HLDA)
73 S VALUE=$$GET1^DIQ(FILE,IENS,FIELD,$S($G(EXT):"",1:"I"),,"ERRORS(1)")
74 I +$G(DIERR) D
75 .S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
76 E D
77 .S ERROR=""
78 ;
79 I $S(+$G(DIERR):0,1:1) D CLEAN^DILF Q VALUE
80 E D CLEAN^DILF Q ""
81 ;
82DELETE(FILE,DA,ERROR) ;Delete an existing record.
83 ; Input:
84 ; FILE - File or sub-file number
85 ; DA - Traditional DA array, with same meaning.
86 ; ** Pass by reference**
87 ;
88 ; Output:
89 ; Function Value - 0=error and 1=no error
90 ; ERROR - optional error message - if needed, pass by reference
91 ;
92 ; Example: To delete a record in subfile 2.0361 in record with ien=353,
93 ; subrecord ien=68:
94 ; S DA=68,DA(1)=353 I $$DELETE^HLEMU(2.0361,.DA,.ERROR) W !,"DONE"
95 ;
96 N DATA
97 S DATA(.01)="@"
98 Q $$UPD^HLEMU(FILE,.DA,.DATA,.ERROR)
99 Q
100 ;
101ADD(FILE,HLDA,DATA,ERROR,IEN) ;
102 ;Description: Creates a new record and files the data.
103 ; Input:
104 ; FILE - File or sub-file number
105 ; HLDA - New name for traditional FileMan DA array with same
106 ; meaning. Pass by reference. Only needed if adding to a
107 ; subfile.
108 ; DATA - Data array to file, pass by reference
109 ; Format: DATA(<field #>)=<value>
110 ; IEN - internal entry number to use (optional)
111 ;
112 ; Output:
113 ; Function Value - If no error then it returns the ien of the created record, else returns NULL.
114 ; HLDA - returns the ien of the new record, NULL if none created. If needed, pass by reference.
115 ; ERROR - optional error message - if needed, pass by reference
116 ;
117 ; Example: Adding a record in subfile 2.0361 in the record with ien=353
118 ; with the field .01 value = 21:
119 ; S DATA(.01)=21,HLDA(1)=353 I $$ADD^HLEMU(2.0361,.HLDA,.DATA) W !,"DONE"
120 ;
121 ; Example: Creating a record NOT in a subfile:
122 ; S DATA(.01)=21 I $$ADD^HLEMU(867,,.DATA) W !,"DONE"
123 ;
124 N FDA,FIELD,IENA,IENS,ERRORS
125 ;
126 ;IENS - Internal Entry Number String defined by FM
127 ;IENA - the Internal Entry Numebr Array defined by FM
128 ;FDA - the FDA array defined by FM
129 ;IEN - the ien of the new record
130 ;
131 S HLDA="+1"
132 S IENS=$$IENS^DILF(.HLDA)
133 S FIELD=0
134 F S FIELD=$O(DATA(FIELD)) Q:'FIELD D
135 .S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
136 I $G(IEN) S IENA(1)=IEN
137 D UPDATE^DIE("","FDA","IENA","ERRORS(1)")
138 I +$G(DIERR) D
139 .S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
140 .S IEN=""
141 E D
142 .S IEN=IENA(1)
143 .S ERROR=""
144 D CLEAN^DILF
145 S HLDA=IEN
146 Q IEN
147 ;
148TESTVAL(FILE,FIELD,VALUE) ;
149 ;Description: returns 1 if VALUE is a valid value for FIELD in FILE
150 ;
151 Q:(('$G(FILE))!('$G(FIELD))) 0
152 ;
153 N DISPLAY,VALID,RESULT
154 S VALID=1
155 ;
156 ;if there is no external value then it is not valid
157 S DISPLAY=$$EXTERNAL^DILFD(FILE,FIELD,"F",VALUE)
158 I (DISPLAY="") S VALID=0
159 ;
160 I VALID,$$GET1^DID(FILE,FIELD,"","TYPE")'["POINTER" D
161 .D CHK^DIE(FILE,FIELD,,VALUE,.RESULT) I RESULT="^" S VALID=0 Q
162 Q VALID
163 ;
164GETLINK(INSTIEN) ;
165 ;Description: Returns name of logical link for institition, given the institution ien. Returns "" if a logical link name not found.
166 ;
167 Q:'$G(INSTIEN) ""
168 ;
169 N LINK,I,LINKNAME
170 S LINKNAME=""
171 D
172 .D LINK^HLUTIL3(INSTIEN,.LINK)
173 .S I=$O(LINK(0))
174 .I I,$L(LINK(I)) S LINKNAME=LINK(I)
175 Q LINKNAME
176 ;
177ASKYESNO(PROMPT,DEFAULT) ;
178 ;Description: Displays PROMPT, appending '?'. Expects a YES NO response.
179 ;Input:
180 ; PROMPT - text to display as prompt. Appends '?'
181 ; DEFAULT - (optional) YES or NO. If not passed, defaults to YES
182 ;Output:
183 ; Function value: 1 if yes, 0 if no, "" if '^' entered or timeout
184 ;
185 N DIR,Y
186 S DIR(0)="Y"
187 S DIR("A")=PROMPT
188 S DIR("B")=$S($G(DEFAULT)="NO":"NO",1:"YES")
189 D ^DIR
190 Q:$D(DIRUT) ""
191 Q Y
192 ;
193MSGIEN(MSGID) ;
194 ;Given the message id, returns the ien from file 773, or 0 on failure.
195 Q:'$L($G(MSGID)) 0
196 Q $O(^HLMA("C",MSGID,0))
197 ;
198LINK(MSGIEN) ;
199 ;Given the message ien from file 773, returns the HL Logical Link in the format <link ien>^<link name>
200 Q:'$G(MSGIEN) ""
201 N LINKIEN
202 S LINKIEN=$P($G(^HLMA(MSGIEN,0)),"^",7)
203 Q:'LINKIEN 0
204 Q LINKIEN_"^"_$P(^HLCS(870,LINKIEN,0),"^")
205 ;
206HL7EVENT(MSGIEN) ;
207 ;Given the message ien from file 773, returns the 3 character HL7 event type
208 Q:'$G(MSGIEN) ""
209 N EVENT
210 S EVENT=$P($G(^HLMA(MSGIEN,0)),"^",14)
211 Q:'EVENT ""
212 Q $P(^HL(779.001,EVENT,0),"^")
213 ;
214MSGTYPE(MSGIEN) ;
215 ;Given the message ien from file 773, returns the 3 character HL7 message type
216 Q:'$G(MSGIEN) ""
217 N MSG
218 S MSG=$P($G(^HLMA(MSGIEN,0)),"^",13)
219 Q:'MSG ""
220 Q $P(^HL(771.2,MSG,0),"^")
221 ;
222APP(MSGIEN) ;
223 ;Given the message ien from file 773, returns the name of the sending application from file 771
224 ;
225 Q:'$G(MSGIEN)
226 N APPIEN
227 S APPIEN=$P($G(^HLMA(MSGIEN,0)),"^",11)
228 Q $$APPNAME(APPIEN)
229 ;
230APPNAME(APPIEN) ;
231 ;Given an ien to the HL7 Application Parameter file (#771), it returns the NAME (field .01)
232 Q $S('APPIEN:"",1:$P($G(^HL(771,APPIEN,0)),"^"))
233 ;
234PROMPT(FILE,FIELD,DEFAULT,RESPONSE,REQUIRE) ;
235 ;Description: requests user to enter a single field value.
236 ;Input:
237 ; FILE - the file #
238 ; FIELD - the field #
239 ; DEFAULT - default value, internal form
240 ; REQUIRE - a flag, (+value)'=0 means to require a value to be
241 ; entered and to return failure otherwise (optional)
242 ;Output:
243 ; Function Value - 0 on failure, 1 on success
244 ; RESPONSE - value entered by user, pass by reference
245 ;
246 Q:(('$G(FILE))!('$G(FIELD))) 0
247 S REQUIRE=$G(REQUIRE)
248 N DIR,DA,QUIT,AGAIN
249 ;
250 S DIR(0)=FILE_","_FIELD_$S($G(REQUIRE):"",1:"O")_"AO"
251 S:$G(DEFAULT)'="" DIR("A")=$$GET1^DID(FILE,FIELD,"","LABEL")_": "_$$EXTERNAL^DILFD(FILE,FIELD,"F",DEFAULT)_"// "
252 S QUIT=0
253 F D Q:QUIT
254 . D ^DIR
255 . I $D(DTOUT)!$D(DUOUT) S QUIT=1 Q
256 . I X="@" D Q:AGAIN
257 . . S AGAIN=0
258 . . I 'REQUIRE,"Yy"'[$E($$ASKYESNO(" Are you sure")_"X") S AGAIN=1 Q
259 . . S RESPONSE="" ; This might trigger the "required" message below.
260 . E I X="" S RESPONSE=$G(DEFAULT)
261 . E S RESPONSE=$P(Y,"^")
262 . ;
263 . ; quit this loop if the user entered value OR value not required
264 . I RESPONSE'="" S QUIT=1 Q
265 . I 'REQUIRE S QUIT=1 Q
266 . W !,"This is a required response. Enter '^' to exit"
267 I $D(DTOUT)!$D(DUOUT) Q 0
268 Q 1
269I(VAR,N) ;This funtion increments the local or global variable by the amount N
270 ;Input:
271 ; VAR - a string representing the name of a local or global variable to be referenced by indirection
272 ; N - a number to increment @VAR by. If not passed it is set to 1
273 ;OUTPUT
274 ; @VAR is incremented by the amount N and also returned as the function value
275 ;
276 N X
277 I VAR["^" L +VAR:1
278 I '$G(N) S N=1
279 S X=$G(@VAR)+N
280 S @VAR=X
281 I VAR["^" L -VAR
282 Q X
283 ;
284INC(VAR,N) ;This funtion increments the local variable by the amount N
285 ;Input:
286 ; VAR - a local or global variable passed by reference
287 ; N - a number to increment VAR by. If not passed or =0 it is set to 1
288 ;OUTPUT
289 ; VAR is incremented by the amount N and also returned as the function value
290 ;
291 I '$G(N) S N=1
292 S VAR=$G(VAR)+N
293 Q VAR
Note: See TracBrowser for help on using the repository browser.