SD694PO.m

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 ---SD694PO   705     printed  Apr 09, 2024@22:00:46                                                                                                                                                                                                      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      ;