Changeset 623 for WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMSTAPI.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMSTAPI.m
r613 r623 1 DGMSTAPI 2 ;;5.3;Registration;**195,243,308,353,379,443,700,VWEHR1**;WorldVistA 30-Jan-08;Build 4 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 GETSTAT(DFN,DGDATE) 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 STATQ 87 88 NEWSTAT(DFN,DGSTAT,DGDATE,DGPROV,DGSITE,DGXMIT) 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 NEWQ 156 157 DELMST(MSTIEN) 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 NAME(DA) 177 178 179 180 181 182 183 NAMEQ 184 185 CHANGE(DFN,DGSTAT,DGDATE) 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 CHNGQ 205 206 SITE(DGSITE) 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 DATE(DFN,DGDT) 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 DATEQ 242 243 VALID(DFN,DGSTAT,DGDATE,DGPROV,DGSITE,DGERR) 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 MSG(DGFIL,DGFLD,DGMSG,DGERR) 282 283 284 285 286 287 288 289 290 291 292 TESTVAL(DGFIL,DGFLD,DGVAL) 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 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
Note:
See TracChangeset
for help on using the changeset viewer.
