source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMSTAPI.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 10.0 KB
Line 
1DGMSTAPI ;ALB/SCK - API's for Military Sexual Trauma ;7:34 PM 30 Jan 2008
2 ;;5.3;Registration;**195,243,308,353,379,443,700,VWEHR1**;WorldVistA 30-Jan-08
3 ;
4 ;Modified from FOIA VISTA,
5 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
6 ;General Public License See attached copy of the License.
7 ;
8 ;This program is free software; you can redistribute it and/or modify
9 ;it under the terms of the GNU General Public License as published by
10 ;the Free Software Foundation; either version 2 of the License, or
11 ;(at your option) any later version.
12 ;
13 ;This program is distributed in the hope that it will be useful,
14 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;GNU General Public License for more details.
17 ;
18 ;You should have received a copy of the GNU General Public License along
19 ;with this program; if not, write to the Free Software Foundation, Inc.,
20 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21 ;
22 Q
23 ;
24GETSTAT(DFN,DGDATE) ; Retrieves the current MST status for a patient
25 ;
26 ; Input
27 ; DFN - IEN of patient in the PATIENT File (#2)
28 ; DGDATE - Date for status lookup [OPTIONAL]
29 ;
30 ; Output
31 ; DGMST - Format will depend on result of lookup
32 ;
33 ; If an entry is found then:
34 ; DGMST returns a 7 piece data string, caret(^)-delimited:
35 ; $P(1) = IEN of entry in MST HISTORY File (#29.11)
36 ; $P(2) = Internal value of MST Status ("Y,N,D,U")
37 ; $P(3) = Date of status change
38 ; $P(4) = IEN of provider making determination, file (#200)
39 ; $P(5) = IEN of user who entered status, file (#200)
40 ; $P(6) = External format of MST Status
41 ; $P(7) = IEN pointer of the INSTITUTION file (#4)
42 ;
43 ; If no MST History is found, then:
44 ; DGMST = 0^U
45 ; "U" = (Unknown)
46 ; If an error occured in the GETS^DIQ lookup, then:
47 ; DGMST = -1^^Error Code IEN
48 ; (returned by GETS^DIQ call)
49 ;
50 ; Get most recent MST status entry for the patient from file using
51 ; reverse $Order on the "APDT" x-ref.
52 ;
53 N DGMST,DGIEN,DGFDA,DGMSG
54 S DFN=$G(DFN)
55 I '+DFN!('$D(^DPT(DFN,0))) D G STATQ
56 . S DGMST="-1"
57 I '$D(^DGMS(29.11,"APDT",DFN)) D G STATQ
58 .S DGMST="0^U"
59 S DGDATE=$S(+$G(DGDATE)>0:DGDATE,1:$$NOW^XLFDT)
60 I '$D(^DGMS(29.11,"APDT",DFN,DGDATE)) S DGDATE=$$DATE(DFN,DGDATE)
61 I '+DGDATE D G STATQ
62 . S DGMST="0^U"
63 S DGIEN=""
64 ;
65 ;WV/EHR REVERSE $Q REPLACEMENT; SO 01/12/08 ;VWEHR1
66 ;
67 ;S DGIEN=+$P($Q(^DGMS(29.11,"APDT",DFN,DGDATE,DGIEN),-1),",",5)
68 S DGIEN=+$P($$Q^VWUTIL($NA(^DGMS(29.11,"APDT",DFN,DGDATE,DGIEN)),-1),",",5)
69 ;
70 ;END CHANGE
71 ;
72 ; Check for valid ien, if entry missing, return Unknown
73 I +DGIEN'>0 D G STATQ
74 . S DGMST="0^U"
75 ;
76 ; Retrieve data
77 D GETS^DIQ(29.11,+DGIEN_",","*","IE","DGFDA","DGMSG")
78 ; check for errors
79 I $D(DGMSG) D G STATQ
80 .S DGMST="-1^^"_$G(DGMSG("DIERR",1))
81 ;
82 S DGMST=DGIEN_U_$G(DGFDA(29.11,+DGIEN_",",3,"I"))_U_$G(DGFDA(29.11,+DGIEN_",",.01,"I"))_U_$G(DGFDA(29.11,+DGIEN_",",4,"I"))_U_$G(DGFDA(29.11,+DGIEN_",",5,"I"))
83 S DGMST=DGMST_U_$G(DGFDA(29.11,+DGIEN_",",3,"E"))
84 S DGMST=DGMST_U_$S($G(DGFDA(29.11,+DGIEN_",",6,"I"))]"":$G(DGFDA(29.11,+DGIEN_",",6,"I")),1:$$SITE)
85 ;
86STATQ Q $G(DGMST)
87 ;
88NEWSTAT(DFN,DGSTAT,DGDATE,DGPROV,DGSITE,DGXMIT) ; MST HISTORY (#29.11) filer
89 ; Callpoint to create a new MST HISTORY FILE (#29.11) entry.
90 ; Will also queue HL7 message for HEC database updates.
91 ;
92 ; Input
93 ; DFN - Patients DFN
94 ; DGSTAT - MST Status code, "Y,N,D,U"
95 ; DGDATE - Date of MST status change [default=NOW]
96 ; DGPROV - IEN of Provider making determination, file (#200)
97 ; DGSITE - IEN pointer of the INSTITUTION file (#4)
98 ; DGXMIT - HL7 transmit flag [OPTIONAL]
99 ; 0=don't queue a message
100 ; 1=queue a message [default])
101 ;
102 ; Output
103 ; DGRSLT - Returns IEN of file (#29.11) entry if successful
104 ;
105 ; If no patient was defined, then:
106 ; DGRSLT = -1^No patient defined
107 ;
108 ; If an error occured in the GETS^DIQ lookup, then:
109 ; DGMST = -1^^Error Code IEN
110 ; (returned by GETS^DIQ call)
111 ;
112 N DGFDA,DGMSG,DGERR,DGRSLT,MSTIEN
113 S DFN=$G(DFN)
114 I DFN']""!('$D(^DPT(DFN,0))) D G NEWQ
115 . S DGRSLT="-1^No patient defined"
116 ;
117 S DGSTAT=$S($G(DGSTAT)]"":DGSTAT,1:"U")
118 S DGDATE=$G(DGDATE)
119 S DGPROV=$G(DGPROV)
120 S DGSITE=$G(DGSITE)
121 S DGXMIT=$S($G(DGXMIT)=0:DGXMIT,1:1)
122 S DGDATE=$S(+DGDATE>0:DGDATE,1:$$NOW^XLFDT)
123 S DGSITE=$S(+DGSITE>0:DGSITE,1:$$SITE)
124 ;
125 I '$$CHANGE(DFN,DGSTAT,DGDATE) D G NEWQ
126 . S DGRSLT="0"
127 ;
128 I '$$VALID(DFN,DGSTAT,DGDATE,DGPROV,DGSITE,.DGERR) D G NEWQ
129 . S DGRSLT="-1^"_DGERR
130 ;
131 S DGFDA(1,29.11,"+1,",.01)=DGDATE
132 S DGFDA(1,29.11,"+1,",2)=DFN
133 S DGFDA(1,29.11,"+1,",3)=DGSTAT
134 S DGFDA(1,29.11,"+1,",4)=DGPROV
135 S DGFDA(1,29.11,"+1,",5)=DUZ
136 S DGFDA(1,29.11,"+1,",6)=DGSITE
137 ;
138 D UPDATE^DIE("","DGFDA(1)","MSTIEN","DGERR")
139 I $D(DGERR) D G NEWQ
140 . S DGRSLT="-1^"_$G(DGERR("DIERR",1))
141 ;
142 S DGRSLT=+MSTIEN(1)
143 ;
144 ; Callpoint to queue an entry that will trigger a HEC
145 ; Enrollment Full Data Transmission (ORF/ORU~ZO7) HL7 message.
146 ; The HL7 message will contain the following three MST data elments
147 ; as part of the VA-Specific Eligibility ZEL segment:
148 ; (23) - MST STATUS
149 ; (24) - DATE MST STATUS CHANGED
150 ; (25) - SITE DETERMINING MST STATUS
151 ;
152 I DGXMIT D
153 . D SEND^DGMSTL1(DFN,"Z07")
154 ;
155NEWQ Q $G(DGRSLT)
156 ;
157DELMST(MSTIEN) ; Deletes the MST HISTORY File (#29.11) entry passed in.
158 ; This call is not to be used except from inside the DG MST List
159 ; Manager interface.
160 ;
161 ; Input
162 ; MSTIEN - IEN of the entry in the MST HISTORY File (#29.11)
163 ;
164 ; Output
165 ; If no IEN passed in, return -1
166 ; otherwise return 1
167 ;
168 Q:'$G(MSTIEN) "-1^No entry to delete"
169 ;
170 N DA,XD
171 S DA=+$G(MSTIEN)
172 S DIK="^DGMS(29.11,"
173 D ^DIK K DIK
174 Q 1
175 ;
176NAME(DA) ; Returns name from the VA NEW PERSON File using DIQ call
177 ;
178 N DGNAME,DGPROV,DIQ,DR,DIC
179 I $G(DA)="" G NAMEQ
180 S DIC=200,DR=".01",DIQ="DGPROV"
181 D EN^DIQ1
182 S DGNAME=$G(DGPROV(200,DA,.01))
183NAMEQ Q $G(DGNAME)
184 ;
185CHANGE(DFN,DGSTAT,DGDATE) ;Did the Status OR Date change?
186 ; Input
187 ; DFN - Patients DFN
188 ; DGSTAT - MST Status code, "Y,N,D,U"
189 ; DGDATE - Date of MST Status Change (FM format)
190 ;
191 ; Output
192 ; Returns 0 if no status change
193 ; 1 if status changed
194 ;
195 N DGCHG,DGMST
196 S DGCHG=0
197 I +$G(DFN)'>0!('$D(^DPT(DFN,0))) G CHNGQ
198 S DGSTAT=$G(DGSTAT)
199 I DGSTAT'?1A!("YNDU"'[DGSTAT) G CHNGQ
200 S DGDATE=$G(DGDATE)
201 I DGDATE="" G CHNGQ
202 S DGMST=$$GETSTAT(DFN),DGMST=$G(DGMST)
203 I +DGMST<1!($P(DGMST,U,2)'=$G(DGSTAT))!($P(DGMST,U,3)'=$G(DGDATE)) S DGCHG=1
204CHNGQ Q DGCHG
205 ;
206SITE(DGSITE) ;Convert a station number into a pointer to the
207 ; INSTITUTION file (#4). If called with a null parameter then
208 ; the pointer to the INSTITUTION file (#4) of the primary site
209 ; will be returned.
210 ;
211 ; Input
212 ; DGSITE - Station number (optional)
213 ;
214 ; Output
215 ; Return Site IEN to INSTITUTION file (#4)
216 ;
217 S DGSITE=$G(DGSITE)
218 I DGSITE]"",$D(^DIC(4,"D",DGSITE)) D
219 . S DGSITE=$O(^DIC(4,"D",DGSITE,0))
220 E D
221 . S DGSITE=$P($$SITE^VASITE,U)
222 I +DGSITE'>0 S DGSITE=""
223 Q DGSITE
224 ;
225DATE(DFN,DGDT) ;Determine 'current' MST date
226 ;
227 ; Input
228 ; DFN - Patient's DFN
229 ; DGDT - FileMan format date
230 ;
231 ; Output
232 ; Return MST effective date
233 ;
234 N DGMSTDT
235 S DFN=$G(DFN)
236 I '+DFN D G DATEQ
237 . S DGMSTDT=""
238 S DGDT=$S(+$G(DGDT)>0:DGDT,1:$$NOW^XLFDT)
239 I $P(DGDT,".",2)="" S DGDT=DGDT_".999999"
240 S DGMSTDT=$O(^DGMS(29.11,"APDT",DFN,DGDT),-1)
241DATEQ Q DGMSTDT
242 ;
243VALID(DFN,DGSTAT,DGDATE,DGPROV,DGSITE,DGERR) ;Validate fields before filing
244 ; Input:
245 ; DFN - [REQUIRED] - ien of Patient
246 ; DGSTAT - [REQUIRED] - MST Status code, "Y,N,D,U"
247 ; DGDATE - [REQUIRED] - Date of MST status change[FileMan Internal]
248 ; DGPROV - [optional] - IEN of Provider making determination
249 ; DGSITE - [optional] - IEN pointer of the INSTITUTION file
250 ; DGERR - [optional] - error parameter passed by reference
251 ; Output:
252 ; Function Value - Returns 1 - if validation checks passed
253 ; 0 - if validation checks failed
254 ; DGERR - an error message if validation checks fail
255 ; init variables
256 N I,DGFILE,DGFLD,DGMSG,DGSTR,DGVAL,DGVAR,DGX,VALID
257 S DGFILE=29.11,VALID=1,DGMSG=" IS REQUIRED"
258 ; Quit DO block if invalid condition found
259 ; Check for [REQUIRED] fields
260 D
261 . I DFN="" D MSG(DGFILE,2,DGMSG,.DGERR) Q ;pat ien
262 . I DGSTAT="" D MSG(DGFILE,3,DGMSG,.DGERR) Q ;mst status code
263 . I DGDATE="" D MSG(DGFILE,.01,DGMSG,.DGERR) Q ;dt chg status
264 .;
265 .; Check for valid FIELD values
266 . S DGMSG=" IS NOT VALID"
267 .; need to strip off the 'seconds' to pass the CHK^DIE() call...
268 . I DGDATE["." N DGSECS S DGSECS=$E($P(DGDATE,".",2),5,6) I DGSECS'="" I DGSECS<0!(DGSECS>60) D MSG(DGFILE,.01,DGMSG,.DGERR) Q
269 . N DGDATEX S DGDATEX=DGDATE
270 . I DGDATEX["." S DGDATEX=$P(DGDATEX,".")_"."_$E($P(DGDATEX,".",2),1,4)
271 . I $E($P(DGDATEX,".",2),1,4)="0000" S DGDATEX=$P(DGDATEX,".")_".1"
272 . S DGSTR=".01;DGDATEX^2;DFN^3;DGSTAT^4;DGPROV^5;DUZ^6;DGSITE"
273 .;
274 . F I=1:1:$L(DGSTR,U) S DGX=$P(DGSTR,U,I) Q:DGX="" D Q:'VALID
275 .. S DGFLD=$P(DGX,";"),DGVAR=$P(DGX,";",2),DGVAL=@DGVAR
276 .. Q:DGVAL=""
277 .. S VALID=$$TESTVAL(DGFILE,DGFLD,DGVAL)
278 .. D:'VALID MSG(DGFILE,DGFLD,DGMSG,.DGERR)
279 Q VALID
280 ;
281MSG(DGFIL,DGFLD,DGMSG,DGERR) ; error message setup
282 ; Input:
283 ; DGFIL - file number
284 ; DGFLD - field number of file
285 ; DGMSG - message type verbiage - " IS REQUIRED" or " IS NOT VALID"
286 ; DGERR - error parameter passed by reference
287 ; Output:
288 ; DGERR - error message
289 S DGERR=$$GET1^DID(DGFIL,DGFLD,,"LABEL")_DGMSG
290 Q
291 ;
292TESTVAL(DGFIL,DGFLD,DGVAL) ; Determine if a field value is valid.
293 ; Input:
294 ; DGFIL - file number
295 ; DGFLD - field number of file
296 ; DGVAL - field value to be validated
297 ; Output:
298 ; Function value: Returns 1 if field is valid
299 ; 0 if validation fails
300 N DGVALEX,DGRSLT,VALID
301 S VALID=1
302 I DGVAL'="" D
303 . S DGVALEX=$$EXTERNAL^DILFD(DGFIL,DGFLD,"F",DGVAL)
304 . I DGVALEX="" S VALID=0 Q ; no external value, not valid
305 . I $$GET1^DID(DGFIL,DGFLD,"","TYPE")'="POINTER" D
306 .. D CHK^DIE(DGFIL,DGFLD,,DGVALEX,.DGRSLT) I DGRSLT="^" S VALID=0
307 Q VALID
Note: See TracBrowser for help on using the repository browser.