Routine: SDEC801P

SDEC801P ;ALB/MGD - SD*5.3*801 Post Init Routine ; Oct 7, 2021@11:45

 ;;5.3;SCHEDULING;**801**;AUG 13, 1993;Build 13

 ;;Per VHA Directive 6402, this routine should not be modified

 ; Reference to $$CREATE^XUSAP In ICR #4677

 ; Reference to ^XWB(8994 (REMOTE PROCEDURE) in ICR #4011

 D FIND

 D RPCNAMCHGS

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

VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.16

 S DA=SDECDA,DIE=409.98,DR="2///1.7.16;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.16;3///"_DT D ^DIE  ;update VS GUI LOCAL

 K DIE,DR,DA

NOFIND ;"VS GUI NATIONAL" NOT FOUND

 D MES^XPDUTL("VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)")

RPCNAMCHGS ; Change RPC names

 D NAMCHG1 ; Change RPC Name from SDES MAKE APPT BLOCK AND MOVE to SDES CREATE APPT BLK AND MOVE

NAMCHG1 ; Change RPC Name from SDES GET APPT to SDES GET APPT BY IEN

 N SDRPCN,SDRPCI

 S SDRPCN="SDES MAKE APPT BLOCK AND MOVE"

 S SDRPCI=0

 S SDRPCI=$$FIND1^DIC(8994,,"B",SDRPCN,"","","SDERR")

 I SDRPCI'>0 D MES^XPDUTL("RPC "_SDRPCN_" not found in REMOTE PROCEDURE file.") Q

 I '$D(^XWB(8994,SDRPCI,0)) D MES^XPDUTL("RPC "_SDRPCN_" not found in REMOTE PROCEDURE file.") Q

 D UPDNAM("SDES CREATE APPT BLK AND MOVE")

UPDNAM(SDNAME) ; Updating RPC name

 N SDERR,SDFDA,ERR

 S SDRPCI=SDRPCI_","

 S SDFDA(8994,SDRPCI,.01)=SDNAME

 D FILE^DIE("","SDFDA","ERR")

 I $D(ERR("DIERR")) D BMES^XPDUTL("    Error in renaming RPC "_SDRPCN_". Error is "_$G(SDERR("DIERR",1,"TEXT",1))) Q

 D BMES^XPDUTL(SDRPCN_" is renamed to "_SDNAME)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC801P   1976     printed  Mar 13, 2025@21:56:21                                                                                                                                                                                                    Page 2

SDEC801P  ;ALB/MGD - SD*5.3*801 Post Init Routine ; Oct 7, 2021@11:45

 +1       ;;5.3;SCHEDULING;**801**;AUG 13, 1993;Build 13

 +2       ;;Per VHA Directive 6402, this routine should not be modified

 +3       ;

 +4       ; Reference to $$CREATE^XUSAP In ICR #4677

 +5       ; Reference to ^XWB(8994 (REMOTE PROCEDURE) in ICR #4011

 +6       ;

 +7        DO FIND

 +8        DO RPCNAMCHGS

 +9        QUIT

 +10      ;

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.16

 +1       ;update VS GUI NATIONAL

           SET DA=SDECDA

           SET DIE=409.98

           SET DR="2///1.7.16;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.16;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       ;

RPCNAMCHGS ; Change RPC names

 +1       ; Change RPC Name from SDES MAKE APPT BLOCK AND MOVE to SDES CREATE APPT BLK AND MOVE

           DO NAMCHG1

 +2        QUIT

NAMCHG1   ; Change RPC Name from SDES GET APPT to SDES GET APPT BY IEN

 +1        NEW SDRPCN,SDRPCI

 +2        SET SDRPCN="SDES MAKE APPT BLOCK AND MOVE"

 +3        SET SDRPCI=0

 +4        SET SDRPCI=$$FIND1^DIC(8994,,"B",SDRPCN,"","","SDERR")

 +5        IF SDRPCI'>0

               DO MES^XPDUTL("RPC "_SDRPCN_" not found in REMOTE PROCEDURE file.")

               QUIT

 +6        IF '$DATA(^XWB(8994,SDRPCI,0))

               DO MES^XPDUTL("RPC "_SDRPCN_" not found in REMOTE PROCEDURE file.")

               QUIT

 +7        DO UPDNAM("SDES CREATE APPT BLK AND MOVE")

 +8        QUIT

UPDNAM(SDNAME) ; Updating RPC name

 +1        NEW SDERR,SDFDA,ERR

 +2        SET SDRPCI=SDRPCI_","

 +3        SET SDFDA(8994,SDRPCI,.01)=SDNAME

 +4        DO FILE^DIE("","SDFDA","ERR")

 +5        IF $DATA(ERR("DIERR"))

               DO BMES^XPDUTL("    Error in renaming RPC "_SDRPCN_". Error is "_$GET(SDERR("DIERR",1,"TEXT",1)))

               QUIT

 +6        DO BMES^XPDUTL(SDRPCN_" is renamed to "_SDNAME)

 +7        QUIT

SDEC801P.m