source: FOIAVistA/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGFIU.m@ 1245

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1RGFIU ;ALB/CJM-MPI/PD NDBI MERGE UTILITY (CONTINUED) ;08/27/99
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**5,13,25**;30 Apr 99
3 ;
4STATNUM(IEN) ;
5 ;Description: Given an ien to the Institution file, returns as the function value the station number. Returns "" on failure.
6 ;
7 N STATION
8 Q:'$G(IEN) ""
9 Q:'$D(^DIC(4,IEN,0)) ""
10 S STATION=$P($$NNT^XUAF4(IEN),"^",2)
11 Q $S(+STATION:STATION,1:"")
12 ;
13UPD(FILE,RGDA,DATA,ERROR) ;File data into an existing record.
14 ; Input:
15 ; FILE - File or sub-file number
16 ; RGDA - New name for traditional DA array, with same meaning.
17 ; Pass by reference.
18 ; DATA - Data array to file (pass by reference)
19 ; Format: DATA(<field #>)=<value>
20 ;
21 ; Output:
22 ; Function Value - 0=error and 1=no error
23 ; ERROR - optional error message - if needed, pass by reference
24 ;
25 ; Example: To update a record in subfile 2.0361 in record with ien=353,
26 ; subrecord ien=68, with the field .01 value = 21:
27 ; S DATA(.01)=21,RGDA=68,RGDA(1)=353 I $$UPD^RGFIU(2.0361,.RGDA,.DATA,.ERROR) W !,"DONE"
28 ;
29 N FDA,FIELD,IENS,ERRORS
30 ;
31 ;IENS - Internal Entry Number String defined by FM
32 ;FDA - the FDA array as defined by FM
33 ;
34 I '$G(RGDA) S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED" Q 0
35 S IENS=$$IENS^DILF(.RGDA)
36 S FIELD=0
37 F S FIELD=$O(DATA(FIELD)) Q:'FIELD D
38 .S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
39 D FILE^DIE("K","FDA","ERRORS(1)")
40 I +$G(DIERR) D
41 .S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
42 E D
43 .S ERROR=""
44 ;
45 I $S(+$G(DIERR):0,1:1) D CLEAN^DILF Q 1
46 E D CLEAN^DILF Q 0
47 ;
48GETFIELD(FILE,FIELD,RGDA,ERROR,EXT) ;Get field value from an existing record.
49 ; Input:
50 ; FILE - File or sub-file number
51 ; RGDA - New name for traditional DA array, with same meaning.
52 ; Pass by reference.
53 ; FIELD - Field for which value is needed
54 ; EXT - (optional) If $G(EXT) then returns the external display form of the value
55 ; Output:
56 ; Function Value - field value in internal format,"" if an error was encountered
57 ; ERROR - optional error message - if needed, pass by reference
58 ;
59 N FDA,IENS,ERRORS,VALUE
60 ;
61 ;IENS - Internal Entry Number String defined by FM
62 ;FDA - the FDA array as defined by FM
63 ;
64 I '$G(RGDA) S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED" Q ""
65 S IENS=$$IENS^DILF(.RGDA)
66 S VALUE=$$GET1^DIQ(FILE,IENS,FIELD,$S($G(EXT):"",1:"I"),,"ERRORS(1)")
67 I +$G(DIERR) D
68 .S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
69 E D
70 .S ERROR=""
71 ;
72 I $S(+$G(DIERR):0,1:1) D CLEAN^DILF Q VALUE
73 E D CLEAN^DILF Q ""
74 ;
75DELETE(FILE,RGDA,ERROR) ;Delete an existing record.
76 ; Input:
77 ; FILE - File or sub-file number
78 ; RGDA - New name for traditional DA array, with same meaning.
79 ; Pass by reference.
80 ;
81 ; Output:
82 ; Function Value - 0=error and 1=no error
83 ; ERROR - optional error message - if needed, pass by reference
84 ;
85 ; Example: To delete a record in subfile 2.0361 in record with ien=353,
86 ; subrecord ien=68:
87 ; S RGDA=68,RGDA(1)=353 I $$DELETE^RGFIU(2.0361,.RGDA,.DATA,.ERROR) W !,"DONE"
88 ;
89 N DATA
90 S DATA(.01)="@"
91 Q $$UPD^RGFIU(FILE,.RGDA,.DATA,.ERROR)
92 Q
93 ;
94ADD(FILE,RGDA,DATA,ERROR,IEN) ;
95 ;Description: Creates a new record and files the data.
96 ; Input:
97 ; FILE - File or sub-file number
98 ; RGDA - New name for traditional FileMan DA array with same
99 ; meaning. Pass by reference. Only needed if adding to a
100 ; subfile.
101 ; DATA - Data array to file, pass by reference
102 ; Format: DATA(<field #>)=<value>
103 ; IEN - internal entry number to use (optional)
104 ;
105 ; Output:
106 ; Function Value - If no error then it returns the ien of the created record, else returns NULL.
107 ; RGDA - returns the ien of the new record, NULL if none created. If needed, pass by reference.
108 ; ERROR - optional error message - if needed, pass by reference
109 ;
110 ; Example: To add a record in subfile 2.0361 in the record with ien=353
111 ; with the field .01 value = 21:
112 ; S DATA(.01)=21,RGDA(1)=353 I $$ADD^RGFIU(2.0361,.RGDA,.DATA) W !,"DONE"
113 ;
114 ; Example: If creating a record not in a subfile, would look like this:
115 ; S DATA(.01)=21 I $$ADD^RGFIU(867,,.DATA) W !,"DONE"
116 ;
117 N FDA,FIELD,IENA,IENS,ERRORS
118 ;
119 ;IENS - Internal Entry Number String defined by FM
120 ;IENA - the Internal Entry Numebr Array defined by FM
121 ;FDA - the FDA array defined by FM
122 ;IEN - the ien of the new record
123 ;
124 S RGDA="+1"
125 S IENS=$$IENS^DILF(.RGDA)
126 S FIELD=0
127 F S FIELD=$O(DATA(FIELD)) Q:'FIELD D
128 .S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
129 I $G(IEN) S IENA(1)=IEN
130 D UPDATE^DIE("","FDA","IENA","ERRORS(1)")
131 I +$G(DIERR) D
132 .S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
133 .S IEN=""
134 E D
135 .S IEN=IENA(1)
136 .S ERROR=""
137 D CLEAN^DILF
138 S RGDA=IEN
139 Q IEN
140 ;
141TESTVAL(FILE,FIELD,VALUE) ;
142 ;Description: returns 1 if VALUE is a valid value for FIELD in FILE
143 ;
144 Q:(('$G(FILE))!('$G(FIELD))) 0
145 ;
146 N DISPLAY,VALID,RESULT
147 S VALID=1
148 ;
149 ;if there is no external value then it is not valid
150 S DISPLAY=$$EXTERNAL^DILFD(FILE,FIELD,"F",VALUE)
151 I (DISPLAY="") S VALID=0
152 ;
153 I VALID,$$GET1^DID(FILE,FIELD,"","TYPE")'["POINTER" D
154 .D CHK^DIE(FILE,FIELD,,VALUE,.RESULT) I RESULT="^" S VALID=0 Q
155 Q VALID
156 ;
157GETLINK(INSTIEN) ;
158 ;Description: Returns name of logical link for institition, given the institution ien. Returns "" if a logical link name not found.
159 ;
160 Q:'$G(INSTIEN) ""
161 ;
162 N LINK,I,LINKNAME
163 S LINKNAME=""
164 D
165 .;don't check if enabled - if shut down, message will be queued
166 .;Q:'$$CHKLL^HLUTIL(INSTIEN)
167 .;
168 .D LINK^HLUTIL3(INSTIEN,.LINK)
169 .S I=$O(LINK(0))
170 .I I,$L(LINK(I)) S LINKNAME=LINK(I)
171 Q LINKNAME
172 ;
173ASKYESNO(PROMPT,DEFAULT) ;
174 ;Description: Displays PROMPT, appending '?'. Expects a YES NO response.
175 ;Input:
176 ; PROMPT - text to display as prompt. Appends '?'
177 ; DEFAULT - (optional) YES or NO. If not passed, defaults to YES
178 ;Output:
179 ; Function value: 1 if yes, 0 if no, "" if '^' entered or timeout
180 ;
181 N DIR,Y
182 S DIR(0)="Y"
183 S DIR("A")=PROMPT
184 S DIR("B")=$S($G(DEFAULT)="NO":"NO",1:"YES")
185 D ^DIR
186 Q:$D(DIRUT) ""
187 Q Y
188 ;
189EXC(RGEXC,RGERR,RGDFN,RGMSGID,RGSITE) ;
190 ;Description: Calls the MPI/PD Exception Handler
191 ;Inputs:
192 ; RGEXC - the exception type
193 ; RGERR - (optional) text
194 ; RGDFN - (optional) patient DFN
195 ; RGMSGID - (optional) HL7 message id
196 ; RGSITE - (optional) station # of site where the exception occurred
197 N ICN
198 I +$G(RGDFN) D
199 .S ICN=+$$GETICN^MPIF001(RGDFN)
200 .I ICN'>0 S ICN=""
201 .S RGERR=$G(RGERR)_" Patient Name: "_$E($$NAME(RGDFN),1,25)_" SSN: "_$$SSN(RGDFN)_" ICN: "_ICN
202 D EXC^RGHLLOG($G(RGEXC),$E($G(RGERR),1,235),$G(RGDFN),$G(RGMSGID),$G(RGSITE))
203 Q
204 ;
205SSN(DFN) ;
206 ;Description: Function returns the patient's SSN, or "" on failure.
207 Q $$GETFIELD(2,.09,.DFN)
208 ;
209NAME(DFN) ;
210 ;Description: Function returns the patient's NAME, or "" on failure.
211 Q $$GETFIELD(2,.01,.DFN)
212 ;
213ICN(DFN) ;Return patient ICN
214 NEW RESULT
215 S RESULT=+$$GETICN^MPIF001($G(DFN))
216 I RESULT<0 Q ""
217 Q +RESULT
218 ;
219DFN(ICN) ;Return patient IEN
220 NEW RESULT
221 I ICN'="" S ICN=+ICN
222 S RESULT=$$GETDFN^MPIF001($G(ICN))
223 I RESULT<0 Q ""
224 Q RESULT
225 ;
226MPINODE(DFN) ;
227 N NODE
228 S NODE=$$MPINODE^MPIFAPI($G(DFN))
229 I +NODE=-1 S NODE=""
230 Q NODE
231 ;
232GETALL(DFN,MPIDATA) ;
233 ;Descripition: Gets the MPI data and treating facility list
234 ;
235 ;Input:
236 ; DFN - patient ien
237 ;Output:
238 ; MPIDATA - output array (pass by reference)
239 ; "ICN") = <ICN>
240 ; "CHKSUM") = <ICN checksum>
241 ; "LOC") = <1 if ICN is local, 0 if national>
242 ; "CMOR") = <station number of CMOR>
243 ; "TF",<station number of TF>,"INSTIEN")=<ien of treating facility in Institution file>
244 ; "TF",<station number of TF>,"LASTDATE")=<date last treated>
245 ; "TF",<station number of TF>,"EVENT")=<ADT event reason (a pointer)>
246 ; "SUB") = <ien of subscriber list>
247 ;
248 N NODE,IEN,STAT,INST,LINK,I,HLL
249 ;
250 K MPIDATA
251 ;
252 ;get MPI data
253 S NODE=$$MPINODE^RGFIU(DFN)
254 S MPIDATA("ICN")=$P(NODE,"^"),MPIDATA("CHKSUM")=$P(NODE,"^",2),MPIDATA("LOC")=$P(NODE,"^",4),MPIDATA("CMOR")=$$STATNUM^RGFIU($P(NODE,"^",3)),MPIDATA("SUB")=$P(NODE,"^",5)
255 ;
256 ;get TF list
257 I MPIDATA("ICN") D
258 .N ARRAY,ITEM,NODE,STAT
259 .Q:$$QUERYTF^VAFCTFU1(MPIDATA("ICN"),"ARRAY")
260 .S ITEM=0
261 .F S ITEM=$O(ARRAY(ITEM)) Q:'ITEM D
262 ..S NODE=ARRAY(ITEM)
263 ..S STAT=$$STATNUM^RGFIU($P(NODE,"^"))
264 ..Q:'STAT
265 ..S MPIDATA("TF",STAT,"INSTIEN")=$P(NODE,"^",1)
266 ..S MPIDATA("TF",STAT,"LASTDATE")=$P(NODE,"^",2)
267 ..S MPIDATA("TF",STAT,"EVENT")=$P(NODE,"^",3)
268 Q
Note: See TracBrowser for help on using the repository browser.