SDEC800P.m

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 ---SDEC800P   3633     printed  Feb 19, 2025@00:17:45                                                                                                                                                                                                    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