[628] | 1 | DGMSTAPI ;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 | ;
|
---|
| 5 | GETSTAT(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 | ;
|
---|
| 61 | STATQ Q $G(DGMST)
|
---|
| 62 | ;
|
---|
| 63 | NEWSTAT(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 | ;
|
---|
| 130 | NEWQ Q $G(DGRSLT)
|
---|
| 131 | ;
|
---|
| 132 | DELMST(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 | ;
|
---|
| 151 | NAME(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))
|
---|
| 158 | NAMEQ Q $G(DGNAME)
|
---|
| 159 | ;
|
---|
| 160 | CHANGE(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
|
---|
| 179 | CHNGQ Q DGCHG
|
---|
| 180 | ;
|
---|
| 181 | SITE(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 | ;
|
---|
| 200 | DATE(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)
|
---|
| 216 | DATEQ Q DGMSTDT
|
---|
| 217 | ;
|
---|
| 218 | VALID(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 | ;
|
---|
| 256 | MSG(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 | ;
|
---|
| 267 | TESTVAL(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
|
---|