SDEC800P ;ALB/MGD - SD*5.3*800 Post Init Routine ; Oct 7, 2021@11:45
;;5.3;SCHEDULING;**800**;AUG 13, 1993;Build 23
;;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
D STOPCODES(SDECDA)
Q
VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.15
S DA=SDECDA,DIE=409.98,DR="2///1.7.15;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.15;3///"_DT D ^DIE ;update VS GUI LOCAL
K DIE,DR,DA
Q
;
STOPCODES(SDECDA) ; VSE-1742; update the VVC STOP CODE multiple for VS GUI NATIONAL entry; add codes 648 and 679; delete code 225
; input - SDECDA: IEN of 409.98
N FDA,SDERR,SDEC225
S SDEC225=$O(^SDEC(409.98,SDECDA,3,"B",225,0))
S FDA(409.987,SDEC225_","_SDECDA_",",.01)="@"
D FILE^DIE("","FDA")
K FDA,SDERR
S FDA(409.987,"?+2,"_SDECDA_",",.01)=648
S FDA(409.987,"?+3,"_SDECDA_",",.01)=679
D UPDATE^DIE("","FDA",,"SDERR")
I $D(SDERR("DIERR")) D BMES^XPDUTL("Error FILING VVC STOP CODE")
Q
;
NOFIND ;"VS GUI NATIONAL" NOT FOUND
D MES^XPDUTL("VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)")
Q
;
CRTPROXYUSR ;create a proxy user
I '$O(^VA(200,"B","SDECPROXY,ACHERON",0)) D
. NEW X,SDOPT
. S SDOPT("SDECRPC")=1
. S SDOPT("SDESRPC")=2
. S X=$$CREATE^XUSAP("SDECPROXY,ACHERON","",.SDOPT) ;#ICR 4677
Q
RPCNAMCHGS ; Change RPC names
D NAMCHG1 ; Change RPC Name from SDES GET APPT to SDES GET APPT BY IEN
D NAMCHG2 ; Change RPC Name from SDES SET APPT REQ CREATE to SDES CREATE APPT REQ
D NAMCHG3 ; Change RPC Name from SDES SET APPT REQ UPDATE to SDES EDIT APPT REQ
Q
NAMCHG1 ; Change RPC Name from SDES GET APPT to SDES GET APPT BY IEN
N SDRPCN,SDRPCI
S SDRPCN="SDES GET APPT"
S SDRPCI=0
S SDRPCI=$O(^XWB(8994,"B",SDRPCN,0)) 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 GET APPT BY IEN")
Q
NAMCHG2 ; Change RPC Name from SDES SET APPT REQ CREATE to SDES CREATE APPT REQ
N SDRPCN,SDRPCI
S SDRPCN="SDES SET APPT REQ CREATE"
S SDRPCI=0
S SDRPCI=$O(^XWB(8994,"B",SDRPCN,0)) 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 REQ")
Q
NAMCHG3 ; Change RPC Name from SDES SET APPT REQ UPDATE to SDES EDIT APPT REQ
N SDRPCN,SDRPCI
S SDRPCN="SDES SET APPT REQ UPDATE"
S SDRPCI=0
S SDRPCI=$O(^XWB(8994,"B",SDRPCN,0)) 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 EDIT APPT REQ")
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC800P 3633 printed Apr 09, 2024@21:40:53 Page 2
SDEC800P ;ALB/MGD - SD*5.3*800 Post Init Routine ; Oct 7, 2021@11:45
+1 ;;5.3;SCHEDULING;**800**;AUG 13, 1993;Build 23
+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 DO FIND
+7 DO RPCNAMCHGS
+8 QUIT
+9 ;
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 DO STOPCODES(SDECDA)
+6 QUIT
VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.15
+1 ;update VS GUI NATIONAL
SET DA=SDECDA
SET DIE=409.98
SET DR="2///1.7.15;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.15;3///"_DT
DO ^DIE
+5 KILL DIE,DR,DA
+6 QUIT
+7 ;
STOPCODES(SDECDA) ; VSE-1742; update the VVC STOP CODE multiple for VS GUI NATIONAL entry; add codes 648 and 679; delete code 225
+1 ; input - SDECDA: IEN of 409.98
+2 NEW FDA,SDERR,SDEC225
+3 SET SDEC225=$ORDER(^SDEC(409.98,SDECDA,3,"B",225,0))
+4 SET FDA(409.987,SDEC225_","_SDECDA_",",.01)="@"
+5 DO FILE^DIE("","FDA")
+6 KILL FDA,SDERR
+7 SET FDA(409.987,"?+2,"_SDECDA_",",.01)=648
+8 SET FDA(409.987,"?+3,"_SDECDA_",",.01)=679
+9 DO UPDATE^DIE("","FDA",,"SDERR")
+10 IF $DATA(SDERR("DIERR"))
DO BMES^XPDUTL("Error FILING VVC STOP CODE")
+11 QUIT
+12 ;
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 ;
CRTPROXYUSR ;create a proxy user
+1 IF '$ORDER(^VA(200,"B","SDECPROXY,ACHERON",0))
Begin DoDot:1
+2 NEW X,SDOPT
+3 SET SDOPT("SDECRPC")=1
+4 SET SDOPT("SDESRPC")=2
+5 ;#ICR 4677
SET X=$$CREATE^XUSAP("SDECPROXY,ACHERON","",.SDOPT)
End DoDot:1
+6 QUIT
RPCNAMCHGS ; Change RPC names
+1 ; Change RPC Name from SDES GET APPT to SDES GET APPT BY IEN
DO NAMCHG1
+2 ; Change RPC Name from SDES SET APPT REQ CREATE to SDES CREATE APPT REQ
DO NAMCHG2
+3 ; Change RPC Name from SDES SET APPT REQ UPDATE to SDES EDIT APPT REQ
DO NAMCHG3
+4 QUIT
NAMCHG1 ; Change RPC Name from SDES GET APPT to SDES GET APPT BY IEN
+1 NEW SDRPCN,SDRPCI
+2 SET SDRPCN="SDES GET APPT"
+3 SET SDRPCI=0
+4 SET SDRPCI=$ORDER(^XWB(8994,"B",SDRPCN,0))
IF SDRPCI'>0
DO MES^XPDUTL("RPC "_SDRPCN_" not found in REMOTE PROCEDURE file.")
QUIT
+5 IF '$DATA(^XWB(8994,SDRPCI,0))
DO MES^XPDUTL("RPC "_SDRPCN_" not found in REMOTE PROCEDURE file.")
QUIT
+6 DO UPDNAM("SDES GET APPT BY IEN")
+7 QUIT
NAMCHG2 ; Change RPC Name from SDES SET APPT REQ CREATE to SDES CREATE APPT REQ
+1 NEW SDRPCN,SDRPCI
+2 SET SDRPCN="SDES SET APPT REQ CREATE"
+3 SET SDRPCI=0
+4 SET SDRPCI=$ORDER(^XWB(8994,"B",SDRPCN,0))
IF SDRPCI'>0
DO MES^XPDUTL("RPC "_SDRPCN_" not found in REMOTE PROCEDURE file.")
QUIT
+5 IF '$DATA(^XWB(8994,SDRPCI,0))
DO MES^XPDUTL("RPC "_SDRPCN_" not found in REMOTE PROCEDURE file.")
QUIT
+6 DO UPDNAM("SDES CREATE APPT REQ")
+7 QUIT
NAMCHG3 ; Change RPC Name from SDES SET APPT REQ UPDATE to SDES EDIT APPT REQ
+1 NEW SDRPCN,SDRPCI
+2 SET SDRPCN="SDES SET APPT REQ UPDATE"
+3 SET SDRPCI=0
+4 SET SDRPCI=$ORDER(^XWB(8994,"B",SDRPCN,0))
IF SDRPCI'>0
DO MES^XPDUTL("RPC "_SDRPCN_" not found in REMOTE PROCEDURE file.")
QUIT
+5 IF '$DATA(^XWB(8994,SDRPCI,0))
DO MES^XPDUTL("RPC "_SDRPCN_" not found in REMOTE PROCEDURE file.")
QUIT
+6 DO UPDNAM("SDES EDIT APPT REQ")
+7 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
