SD694PO ;ALB/WTC/ZEB - VISTA SCHEDULING RPCS ;JUL 09,2019@0:09 AM
;;5.3;Scheduling;**694**;;Build 61
;;Per VA Directive 6402, this routine should not be modified
;
D RUN ;
Q ;
;
RUN ;
;
;Set up SDECSETTINGS mail group to trigger updates to SDEC SETTINGS file (#409.98).
;
N DO,DD,DA,DLAYGO,DIC,X,RCSITE
S RCSITE=$G(^XMB("NETNAME")) Q:RCSITE="" ; SITE DOMAIN NAME
S X="S.SDEC SETTINGS REMOTE UPDATE@"_RCSITE ; SERVER NAME WITH SITE DOMAIN NAME
S DA(1)=$O(^XMB(3.8,"B","SDECSETTINGS",0)) ; MAIL GROUP IEN
I $D(^XMB(3.8,DA(1),6,"B",$E(X,1,30))) Q ; MAIL ADDRESS ALREADY EXISTS.
S DLAYGO=3.812,DIC(0)="L",DIC="^XMB(3.8,"_DA(1)_",6,"
D FILE^DICN ;
Q ;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD694PO 705 printed Oct 16, 2024@18:47:28 Page 2
SD694PO ;ALB/WTC/ZEB - VISTA SCHEDULING RPCS ;JUL 09,2019@0:09 AM
+1 ;;5.3;Scheduling;**694**;;Build 61
+2 ;;Per VA Directive 6402, this routine should not be modified
+3 ;
+4 ;
DO RUN
+5 ;
QUIT
+6 ;
RUN ;
+1 ;
+2 ;Set up SDECSETTINGS mail group to trigger updates to SDEC SETTINGS file (#409.98).
+3 ;
+4 NEW DO,DD,DA,DLAYGO,DIC,X,RCSITE
+5 ; SITE DOMAIN NAME
SET RCSITE=$GET(^XMB("NETNAME"))
if RCSITE=""
QUIT
+6 ; SERVER NAME WITH SITE DOMAIN NAME
SET X="S.SDEC SETTINGS REMOTE UPDATE@"_RCSITE
+7 ; MAIL GROUP IEN
SET DA(1)=$ORDER(^XMB(3.8,"B","SDECSETTINGS",0))
+8 ; MAIL ADDRESS ALREADY EXISTS.
IF $DATA(^XMB(3.8,DA(1),6,"B",$EXTRACT(X,1,30)))
QUIT
+9 SET DLAYGO=3.812
SET DIC(0)="L"
SET DIC="^XMB(3.8,"_DA(1)_",6,"
+10 ;
DO FILE^DICN
+11 ;
QUIT
+12 ;
