Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDEC801P

SDEC801P.m

Go to the documentation of this file.
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
 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.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
 Q
 ;
NOFIND ;"VS GUI NATIONAL" NOT FOUND
 D MES^XPDUTL("VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)")
 Q
 ;
RPCNAMCHGS ; Change RPC names
 D NAMCHG1 ; Change RPC Name from SDES MAKE APPT BLOCK AND MOVE to SDES CREATE APPT BLK AND MOVE
 Q
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")
 Q
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)
 Q