| 1 | DGMSTAPI ;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 | ;
|
|---|
| 24 | GETSTAT(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 | ;
|
|---|
| 86 | STATQ Q $G(DGMST)
|
|---|
| 87 | ;
|
|---|
| 88 | NEWSTAT(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 | ;
|
|---|
| 155 | NEWQ Q $G(DGRSLT)
|
|---|
| 156 | ;
|
|---|
| 157 | DELMST(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 | ;
|
|---|
| 176 | NAME(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))
|
|---|
| 183 | NAMEQ Q $G(DGNAME)
|
|---|
| 184 | ;
|
|---|
| 185 | CHANGE(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
|
|---|
| 204 | CHNGQ Q DGCHG
|
|---|
| 205 | ;
|
|---|
| 206 | SITE(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 | ;
|
|---|
| 225 | DATE(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)
|
|---|
| 241 | DATEQ Q DGMSTDT
|
|---|
| 242 | ;
|
|---|
| 243 | VALID(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 | ;
|
|---|
| 281 | MSG(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 | ;
|
|---|
| 292 | TESTVAL(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
|
|---|
