XDRDEFLG ;SF-IRMFO/TKW - SILENT API TO UPDATE THE SUPPRESS NEW DUP EMAIL FLAG ;9/19/08 16:57
;;7.3;TOOLKIT;**113**;Apr 25, 1995;Build 5
;;Per VHA Directive 2004-038, this routine should not be modified
EN(XDRSLT,XDRFL,XDRVAL) ; Update the SUPPRESS NEW DUP EMAIL field on record in file #15.1
; Called from REMOTE PROCEDURE - XDR UPD EMAIL FLAG
; XDRSLT = OUTPUT results.
; set to 0 if update was successful, -1^ERRMSG if error
; XDRFL = 'FILE TO BE CHECKED' field value in file 15.1, defaults to PATIENT file.
; XDRVAL = 0 or 1 (value to set into field)
;
K XDRSLT
N XDRGBL,XDRFDA
; Default file is PATIENT file.
S XDRFL=+$G(XDRFL)
S:'XDRFL XDRFL=2
; Check file number input parameter
S XDRGBL=$G(^DIC(XDRFL,0,"GL"))
I (XDRGBL="")!($G(^VA(15.1,XDRFL,0))="") D Q
. S XDRSLT="-1^File number parameter missing or invalid" Q
; Make sure XDRVAL is set to 0 or 1
S XDRVAL=$G(XDRVAL)
I XDRVAL'=0,XDRVAL'=1 D Q
. S XDRSLT="-1^Value parameter is invalid, must be set to 0 or 1" Q
; Update SUPPRESS NEW DUP EMAIL field.
S XDRFDA(15.1,XDRFL_",",99)=XDRVAL
D FILE^DIE("","XDRFDA")
I $D(^TMP("DIERR",$J)) D Q
. S XDRSLT="-1^Error updating FIELD 99, FILE 15.1, REC: "_XDRFL_" - "_$G(^TMP("DIERR",$J,1,"TEXT",1))
. Q
; Success
S XDRSLT=0
Q
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRDEFLG 1306 printed Oct 16, 2024@18:39:38 Page 2
XDRDEFLG ;SF-IRMFO/TKW - SILENT API TO UPDATE THE SUPPRESS NEW DUP EMAIL FLAG ;9/19/08 16:57
+1 ;;7.3;TOOLKIT;**113**;Apr 25, 1995;Build 5
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
EN(XDRSLT,XDRFL,XDRVAL) ; Update the SUPPRESS NEW DUP EMAIL field on record in file #15.1
+1 ; Called from REMOTE PROCEDURE - XDR UPD EMAIL FLAG
+2 ; XDRSLT = OUTPUT results.
+3 ; set to 0 if update was successful, -1^ERRMSG if error
+4 ; XDRFL = 'FILE TO BE CHECKED' field value in file 15.1, defaults to PATIENT file.
+5 ; XDRVAL = 0 or 1 (value to set into field)
+6 ;
+7 KILL XDRSLT
+8 NEW XDRGBL,XDRFDA
+9 ; Default file is PATIENT file.
+10 SET XDRFL=+$GET(XDRFL)
+11 if 'XDRFL
SET XDRFL=2
+12 ; Check file number input parameter
+13 SET XDRGBL=$GET(^DIC(XDRFL,0,"GL"))
+14 IF (XDRGBL="")!($GET(^VA(15.1,XDRFL,0))="")
Begin DoDot:1
+15 SET XDRSLT="-1^File number parameter missing or invalid"
QUIT
End DoDot:1
QUIT
+16 ; Make sure XDRVAL is set to 0 or 1
+17 SET XDRVAL=$GET(XDRVAL)
+18 IF XDRVAL'=0
IF XDRVAL'=1
Begin DoDot:1
+19 SET XDRSLT="-1^Value parameter is invalid, must be set to 0 or 1"
QUIT
End DoDot:1
QUIT
+20 ; Update SUPPRESS NEW DUP EMAIL field.
+21 SET XDRFDA(15.1,XDRFL_",",99)=XDRVAL
+22 DO FILE^DIE("","XDRFDA")
+23 IF $DATA(^TMP("DIERR",$JOB))
Begin DoDot:1
+24 SET XDRSLT="-1^Error updating FIELD 99, FILE 15.1, REC: "_XDRFL_" - "_$GET(^TMP("DIERR",$JOB,1,"TEXT",1))
+25 QUIT
End DoDot:1
QUIT
+26 ; Success
+27 SET XDRSLT=0
+28 QUIT
+29 ;
+30 ;
