XDRDEFLG.m

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 ---XDRDEFLG   1306     printed  Apr 09, 2024@21:43:04                                                                                                                                                                                                    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      ;