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

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

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