SDEC809P ;ALB/LAB - SD*5.3*809 Post Init Routine ; Feb 16, 2022@09:58
 ;;5.3;SCHEDULING;**809**;AUG 13, 1993;Build 10
 ;;Per VHA Directive 6402, this routine should not be modified
 ;
 D FIND
 D RA
 Q
 ;
FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
 N SDECDA,SDECDA1
 D MES^XPDUTL("Updating SDEC SETTINGS file (#409.98)")
 S SDECDA=0,SDECDA=$O(^SDEC(409.98,"B","VS GUI NATIONAL",SDECDA)) G:$G(SDECDA)="" NOFIND
 D VERSION   ;update GUI version number and date
 Q
VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.21
 S DA=SDECDA,DIE=409.98,DR="2///1.7.21;3///"_DT D ^DIE  ;update VS GUI NATIONAL
 K DIE,DR,DA
 S SDECDA1=0,SDECDA1=$O(^SDEC(409.98,"B","VS GUI LOCAL",SDECDA1)) Q:$G(SDECDA1)=""    ;get DA for the VS GUI LOCAL
 S DA=SDECDA1,DIE=409.98,DR="2///1.7.21;3///"_DT D ^DIE  ;update VS GUI LOCAL
 K DIE,DR,DA
 Q
 ;
NOFIND ;"VS GUI NATIONAL" NOT FOUND
 D MES^XPDUTL("VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)")
 Q
 ;
RA ; Create record to add & update file
 ; This TAG adds an entry to the REMOTE APPLICATION file (#8994.5) for ENTERPRISE APPOINTMENT SERVICE
 N ARY,OPTIEN
 D BMES^XPDUTL("Adding ENTERPRISE APPOINTMENT SERVICE to the REMOTE APPLICATION (#8994.5) file.")
 S OPTIEN=+$O(^DIC(19,"B","SDESRPC",""))
 I 'OPTIEN D BMES^XPDUTL("SDESRPC Option not found in the OPTION (#19) file.") Q
 ; Set up array and create entry
 S ARY(8994.5,"?+1,",.01)="ENTERPRISE APPOINTMENT SERVICE"  ;Remote application name
 S ARY(8994.5,"?+1,",.02)=OPTIEN  ;Context option IEN FOR ""
 S ARY(8994.5,"?+1,",.03)="I3u6b0H0Rc3Qk5CV5GoGqnQ+6Gi6uF6pzyN9q7foKA4="  ;Application code
 S ARY(8994.51,"?+2,?+1,",.01)="R"   ;Callback type = RPC-BROKER
 S ARY(8994.51,"?+2,?+1,",.02)=-1    ;Callback port
 S ARY(8994.51,"?+2,?+1,",.03)="XXX" ;Callback server
 D UPDATE^DIE("","ARY","","MSG")     ;Update Remote Application file with new ENTERPRISE APPOINTMENT SERVICE entry
 I $G(MSG("DIERR"))="" D  Q
 .D BMES^XPDUTL("ENTERPRISE APPOINTMENT SERVICE successfully added to the REMOTE APPLICATION")
 .D MES^XPDUTL("(#8994.5) file.")
 I $G(MSG("DIERR"))'="" D
 .N ERR,LN,LN2,X
 .S (ERR,LN2)=0
 .F  S ERR=+$O(MSG("DIERR",ERR)) Q:'ERR  D
 ..S LN=0
 ..F  S LN=+$O(MSG("DIERR",ERR,"TEXT",LN)) Q:'LN  D
 ...S LN2=LN2+1
 ...S X(LN2)=MSG("DIERR",ERR,"TEXT",LN)
 ...D BMES^XPDUTL(X(LN2))
 .K MSG
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC809P   2361     printed  Sep 23, 2025@20:27:50                                                                                                                                                                                                    Page 2
SDEC809P  ;ALB/LAB - SD*5.3*809 Post Init Routine ; Feb 16, 2022@09:58
 +1       ;;5.3;SCHEDULING;**809**;AUG 13, 1993;Build 10
 +2       ;;Per VHA Directive 6402, this routine should not be modified
 +3       ;
 +4        DO FIND
 +5        DO RA
 +6        QUIT 
 +7       ;
FIND      ;FIND THE IEN FOR "VS GUI NATIONAL"
 +1        NEW SDECDA,SDECDA1
 +2        DO MES^XPDUTL("Updating SDEC SETTINGS file (#409.98)")
 +3        SET SDECDA=0
           SET SDECDA=$ORDER(^SDEC(409.98,"B","VS GUI NATIONAL",SDECDA))
           if $GET(SDECDA)=""
               GOTO NOFIND
 +4       ;update GUI version number and date
           DO VERSION
 +5        QUIT 
VERSION   ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.21
 +1       ;update VS GUI NATIONAL
           SET DA=SDECDA
           SET DIE=409.98
           SET DR="2///1.7.21;3///"_DT
           DO ^DIE
 +2        KILL DIE,DR,DA
 +3       ;get DA for the VS GUI LOCAL
           SET SDECDA1=0
           SET SDECDA1=$ORDER(^SDEC(409.98,"B","VS GUI LOCAL",SDECDA1))
           if $GET(SDECDA1)=""
               QUIT 
 +4       ;update VS GUI LOCAL
           SET DA=SDECDA1
           SET DIE=409.98
           SET DR="2///1.7.21;3///"_DT
           DO ^DIE
 +5        KILL DIE,DR,DA
 +6        QUIT 
 +7       ;
NOFIND    ;"VS GUI NATIONAL" NOT FOUND
 +1        DO MES^XPDUTL("VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)")
 +2        QUIT 
 +3       ;
RA        ; Create record to add & update file
 +1       ; This TAG adds an entry to the REMOTE APPLICATION file (#8994.5) for ENTERPRISE APPOINTMENT SERVICE
 +2        NEW ARY,OPTIEN
 +3        DO BMES^XPDUTL("Adding ENTERPRISE APPOINTMENT SERVICE to the REMOTE APPLICATION (#8994.5) file.")
 +4        SET OPTIEN=+$ORDER(^DIC(19,"B","SDESRPC",""))
 +5        IF 'OPTIEN
               DO BMES^XPDUTL("SDESRPC Option not found in the OPTION (#19) file.")
               QUIT 
 +6       ; Set up array and create entry
 +7       ;Remote application name
           SET ARY(8994.5,"?+1,",.01)="ENTERPRISE APPOINTMENT SERVICE"
 +8       ;Context option IEN FOR ""
           SET ARY(8994.5,"?+1,",.02)=OPTIEN
 +9       ;Application code
           SET ARY(8994.5,"?+1,",.03)="I3u6b0H0Rc3Qk5CV5GoGqnQ+6Gi6uF6pzyN9q7foKA4="
 +10      ;Callback type = RPC-BROKER
           SET ARY(8994.51,"?+2,?+1,",.01)="R"
 +11      ;Callback port
           SET ARY(8994.51,"?+2,?+1,",.02)=-1
 +12      ;Callback server
           SET ARY(8994.51,"?+2,?+1,",.03)="XXX"
 +13      ;Update Remote Application file with new ENTERPRISE APPOINTMENT SERVICE entry
           DO UPDATE^DIE("","ARY","","MSG")
 +14       IF $GET(MSG("DIERR"))=""
               Begin DoDot:1
 +15               DO BMES^XPDUTL("ENTERPRISE APPOINTMENT SERVICE successfully added to the REMOTE APPLICATION")
 +16               DO MES^XPDUTL("(#8994.5) file.")
               End DoDot:1
               QUIT 
 +17       IF $GET(MSG("DIERR"))'=""
               Begin DoDot:1
 +18               NEW ERR,LN,LN2,X
 +19               SET (ERR,LN2)=0
 +20               FOR 
                       SET ERR=+$ORDER(MSG("DIERR",ERR))
                       if 'ERR
                           QUIT 
                       Begin DoDot:2
 +21                       SET LN=0
 +22                       FOR 
                               SET LN=+$ORDER(MSG("DIERR",ERR,"TEXT",LN))
                               if 'LN
                                   QUIT 
                               Begin DoDot:3
 +23                               SET LN2=LN2+1
 +24                               SET X(LN2)=MSG("DIERR",ERR,"TEXT",LN)
 +25                               DO BMES^XPDUTL(X(LN2))
                               End DoDot:3
                       End DoDot:2
 +26               KILL MSG
               End DoDot:1
 +27       QUIT