Routine: XU8PS630

XU8PS630 ;ISD/HGW - Post-Install for 630 ;04/28/17  12:11

 ;;8.0;KERNEL;**630**;Jul 10, 1995;Build 13

 ;Per VA Directive 6402, this routine should not be modified.

 ;  Post Installation Routine for patch XU*8.0*630

 ;  Installs entry into the REMOTE APPLICATION file (#8994.5)

 ;  EXTERNAL REFERENCES

 ;    BMES^XPDUTL 10141

 ;    $$FIND1^DIC

 ;    UPDATE^DIE 2053

MAIN ; Control subroutine

 N XU8ERRX,XU8DATA

 ; "JLV BSE" to record JLV VISITOR access in the SIGN-ON LOG... JLV determines pass phrase

 S XU8DATA(1)="JLV BSE" ; Name

 S XU8DATA(2)="JLV WEB SERVICES" ; ContextOption Name

 S XU8DATA(3)="JLV GUI Menu Option" ; ContextOption Menu Text

 S XU8DATA(4)="janusJLVD0n0tl00K" ; Security phrase (case sensitive)

 S XU8DATA(5)="S"_"^"_"-1"_"^"_""_"^"_""

 S XU8ERRX=$$OPTION(.XU8DATA) ; Create CONTEXTOPTION if doesn't exist

 S XU8ERRX=$$CREATE(.XU8DATA) ; Create REMOTE APPLICATION entry

 D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Success message" or "Error text"

 ; "JLV NHIN" to record DoD access in the SIGN-ON LOG... NHIN token determines pass phrase

 K XU8DATA

 S XU8DATA(1)="JLV NHIN" ; Name

 S XU8DATA(2)="JLV WEB SERVICES" ; ContextOption Name

 S XU8DATA(3)="JLV GUI Menu Option" ; ContextOption Menu Text

 S XU8DATA(4)="joint_legacy_viewer/jlv.exe" ; Security phrase (case sensitive)

 S XU8DATA(5)="S"_"^"_"-1"_"^"_""_"^"_""

 S XU8ERRX=$$OPTION(.XU8DATA) ; Create CONTEXTOPTION if doesn't exist

 S XU8ERRX=$$CREATE(.XU8DATA) ; Create REMOTE APPLICATION entry

 D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Success message" or "Error text"

 ; "JLV" to record SSOi access in the SIGN-ON LOG... SSOi token determines pass phrase

 ;TBD

 ; "CAPRI GUI" to record CAPRI access in the SIGN-ON LOG

 K XU8DATA

 S XU8DATA(1)="CAPRI GUI" ; Name

 S XU8DATA(4)="delphi_rpc_broker/capri.exe" ; Security phrase (case sensitive)

 S XU8DATA(5)="S"_"^"_"-1"_"^"_""_"^"_""

 S XU8ERRX=$$CREATE(.XU8DATA) ; Create REMOTE APPLICATION entry

OPTION(XU8DATA) ; Create CONTEXTOPTION if doesn't exist

 N XU8ERR,XU8FDA,XU8IEN,XU8MSG

 S XU8IEN=$$FIND1^DIC(19,"","X",XU8DATA(2),"B")

 S XU8ERR="Error message: "_XU8IEN

 I +XU8IEN>0 S XU8ERR="OPTION exists at IEN = "_XU8IEN

 I +XU8IEN=0 S XU8ERR="OPTION "_XU8DATA(2)_" created" D

 . S XU8FDA(19,"?+1,",.01)=XU8DATA(2)

 . S XU8FDA(19,"?+1,",1)=XU8DATA(3)

 . S XU8FDA(19,"?+1,",4)="B" ; B:Broker (Client/Server)

 . D UPDATE^DIE("","XU8FDA","XU8IEN","XU8MSG")

 . I $D(XU8MSG) S XU8ERR="   **ERROR** "_$G(XU8MSG("DIERR",1))_" Unable to create OPTION entry "_XU8DATA(2)

 D CLEAN^DILF

 Q XU8ERR

CREATE(XU8DATA) ; Create new REMOTE APPLICATION entry

 N XU8ERR,XU8FDA,XU8IEN,XU8MSG,XU8I,XU8IENS,DA,DIK

 ; Delete existing entry if it exists, before creating updated entry

 S XU8IEN=$$FIND1^DIC(8994.5,"","X",XU8DATA(1),"B")

 I $G(XU8IEN)>0 D

 . S DIK="^XWB(8994.5,",DA=XU8IEN

 . D ^DIK

 . K XU8IEN

 S XU8ERR="   REMOTE APPLICATION entry created: "_XU8DATA(1)

 S XU8FDA(8994.5,"?+1,",.01)=XU8DATA(1) ; NAME

 I $D(XU8DATA(2)) S XU8FDA(8994.5,"?+1,",.02)=$$FIND1^DIC(19,"","X",XU8DATA(2),"B") ; CONTEXTOPTION

 S XU8FDA(8994.5,"?+1,",.03)=$$SHAHASH^XUSHSH(256,XU8DATA(4),"B") ; APPLICATIONCODE

 D UPDATE^DIE("","XU8FDA","XU8IEN","XU8MSG")

 I $D(XU8MSG) D

 . S XU8ERR="   **ERROR** "_$G(XU8MSG("DIERR",1))_" Unable to create REMOTE APPLICATION "_XU8DATA(1)

 ; Find the REMOTE APPLICATION

 S XU8IENS=$$FIND1^DIC(8994.5,"","X",XU8DATA(1),"B")

 I +XU8IENS<1 S XU8ERR=XU8IENS Q XU8ERR

 ; Fill in CALLBACKTYPE multiple

 S XU8I=4 F  S XU8I=$O(XU8DATA(XU8I)) Q:XU8I=""  D

 . N XU8FDA,XU8IEN,XU8MSG,XU8TEST,XU8J,XU8FLAG

 . ; Check for duplicates (loop through CALLBACKTYPE for this entry)

 . S XU8J=0 F  S XU8J=$O(^XWB(8994.5,XU8IENS,1,"B",$E(XU8DATA(XU8I),1,1),XU8J)) Q:(XU8J="")!($D(XU8FLAG))  D

 . . I $G(XU8DATA(XU8I))=$G(^XWB(8994.5,XU8IENS,1,XU8J,0)) S XU8FLAG=1

 . I '$D(XU8FLAG) D

 . . S XU8FDA(8994.51,"+2,"_XU8IENS_",",.01)=$P(XU8DATA(XU8I),"^",1) ; CALLBACKTYPE

 . . S XU8FDA(8994.51,"+2,"_XU8IENS_",",.02)=$P(XU8DATA(XU8I),"^",2) ; CALLBACKPORT

 . . S XU8FDA(8994.51,"+2,"_XU8IENS_",",.03)=$P(XU8DATA(XU8I),"^",3) ; CALLBACKSERVER

 . . S XU8FDA(8994.51,"+2,"_XU8IENS_",",.04)=$P(XU8DATA(XU8I),"^",4) ; URLSTRING

 . . D UPDATE^DIE("","XU8FDA","XU8IEN","XU8MSG")

 . . I $D(XU8MSG) D

 . . . S XU8ERR="   **ERROR** "_$G(XU8MSG("DIERR",1))_" Unable to update REMOTE APPLICATION "_XU8DATA(1)

 D CLEAN^DILF

 Q XU8ERR

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8PS630   4450     printed  Apr 23, 2025@18:23:24                                                                                                                                                                                                    Page 2

XU8PS630  ;ISD/HGW - Post-Install for 630 ;04/28/17  12:11

 +1       ;;8.0;KERNEL;**630**;Jul 10, 1995;Build 13

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

 +3       ;  Post Installation Routine for patch XU*8.0*630

 +4       ;

 +5       ;  Installs entry into the REMOTE APPLICATION file (#8994.5)

 +6       ;

 +7       ;  EXTERNAL REFERENCES

 +8       ;    BMES^XPDUTL 10141

 +9       ;    $$FIND1^DIC

 +10      ;    UPDATE^DIE 2053

 +11      ;

MAIN      ; Control subroutine

 +1        NEW XU8ERRX,XU8DATA

 +2       ;

 +3       ; "JLV BSE" to record JLV VISITOR access in the SIGN-ON LOG... JLV determines pass phrase

 +4       ; Name

           SET XU8DATA(1)="JLV BSE"

 +5       ; ContextOption Name

           SET XU8DATA(2)="JLV WEB SERVICES"

 +6       ; ContextOption Menu Text

           SET XU8DATA(3)="JLV GUI Menu Option"

 +7       ; Security phrase (case sensitive)

           SET XU8DATA(4)="janusJLVD0n0tl00K"

 +8        SET XU8DATA(5)="S"_"^"_"-1"_"^"_""_"^"_""

 +9       ; Create CONTEXTOPTION if doesn't exist

           SET XU8ERRX=$$OPTION(.XU8DATA)

 +10      ; Create REMOTE APPLICATION entry

           SET XU8ERRX=$$CREATE(.XU8DATA)

 +11      ; XU8ERRX is "Success message" or "Error text"

           DO BMES^XPDUTL(XU8ERRX)

 +12      ;

 +13      ; "JLV NHIN" to record DoD access in the SIGN-ON LOG... NHIN token determines pass phrase

 +14       KILL XU8DATA

 +15      ; Name

           SET XU8DATA(1)="JLV NHIN"

 +16      ; ContextOption Name

           SET XU8DATA(2)="JLV WEB SERVICES"

 +17      ; ContextOption Menu Text

           SET XU8DATA(3)="JLV GUI Menu Option"

 +18      ; Security phrase (case sensitive)

           SET XU8DATA(4)="joint_legacy_viewer/jlv.exe"

 +19       SET XU8DATA(5)="S"_"^"_"-1"_"^"_""_"^"_""

 +20      ; Create CONTEXTOPTION if doesn't exist

           SET XU8ERRX=$$OPTION(.XU8DATA)

 +21      ; Create REMOTE APPLICATION entry

           SET XU8ERRX=$$CREATE(.XU8DATA)

 +22      ; XU8ERRX is "Success message" or "Error text"

           DO BMES^XPDUTL(XU8ERRX)

 +23      ;

 +24      ; "JLV" to record SSOi access in the SIGN-ON LOG... SSOi token determines pass phrase

 +25      ;TBD

 +26      ;

 +27      ; "CAPRI GUI" to record CAPRI access in the SIGN-ON LOG

 +28       KILL XU8DATA

 +29      ; Name

           SET XU8DATA(1)="CAPRI GUI"

 +30      ; Security phrase (case sensitive)

           SET XU8DATA(4)="delphi_rpc_broker/capri.exe"

 +31       SET XU8DATA(5)="S"_"^"_"-1"_"^"_""_"^"_""

 +32      ; Create REMOTE APPLICATION entry

           SET XU8ERRX=$$CREATE(.XU8DATA)

 +33      ;

 +34       QUIT

 +35      ;

OPTION(XU8DATA) ; Create CONTEXTOPTION if doesn't exist

 +1        NEW XU8ERR,XU8FDA,XU8IEN,XU8MSG

 +2        SET XU8IEN=$$FIND1^DIC(19,"","X",XU8DATA(2),"B")

 +3        SET XU8ERR="Error message: "_XU8IEN

 +4        IF +XU8IEN>0

               SET XU8ERR="OPTION exists at IEN = "_XU8IEN

 +5        IF +XU8IEN=0

               SET XU8ERR="OPTION "_XU8DATA(2)_" created"

               Begin DoDot:1

 +6                SET XU8FDA(19,"?+1,",.01)=XU8DATA(2)

 +7                SET XU8FDA(19,"?+1,",1)=XU8DATA(3)

 +8       ; B:Broker (Client/Server)

                   SET XU8FDA(19,"?+1,",4)="B"

 +9                DO UPDATE^DIE("","XU8FDA","XU8IEN","XU8MSG")

 +10               IF $DATA(XU8MSG)

                       SET XU8ERR="   **ERROR** "_$GET(XU8MSG("DIERR",1))_" Unable to create OPTION entry "_XU8DATA(2)

               End DoDot:1

 +11       DO CLEAN^DILF

 +12       QUIT XU8ERR

 +13      ;

CREATE(XU8DATA) ; Create new REMOTE APPLICATION entry

 +1        NEW XU8ERR,XU8FDA,XU8IEN,XU8MSG,XU8I,XU8IENS,DA,DIK

 +2       ; Delete existing entry if it exists, before creating updated entry

 +3        SET XU8IEN=$$FIND1^DIC(8994.5,"","X",XU8DATA(1),"B")

 +4        IF $GET(XU8IEN)>0

               Begin DoDot:1

 +5                SET DIK="^XWB(8994.5,"

                   SET DA=XU8IEN

 +6                DO ^DIK

 +7                KILL XU8IEN

               End DoDot:1

 +8        SET XU8ERR="   REMOTE APPLICATION entry created: "_XU8DATA(1)

 +9       ; NAME

           SET XU8FDA(8994.5,"?+1,",.01)=XU8DATA(1)

 +10      ; CONTEXTOPTION

           IF $DATA(XU8DATA(2))

               SET XU8FDA(8994.5,"?+1,",.02)=$$FIND1^DIC(19,"","X",XU8DATA(2),"B")

 +11      ; APPLICATIONCODE

           SET XU8FDA(8994.5,"?+1,",.03)=$$SHAHASH^XUSHSH(256,XU8DATA(4),"B")

 +12       DO UPDATE^DIE("","XU8FDA","XU8IEN","XU8MSG")

 +13       IF $DATA(XU8MSG)

               Begin DoDot:1

 +14               SET XU8ERR="   **ERROR** "_$GET(XU8MSG("DIERR",1))_" Unable to create REMOTE APPLICATION "_XU8DATA(1)

               End DoDot:1

 +15      ; Find the REMOTE APPLICATION

 +16       SET XU8IENS=$$FIND1^DIC(8994.5,"","X",XU8DATA(1),"B")

 +17       IF +XU8IENS<1

               SET XU8ERR=XU8IENS

               QUIT XU8ERR

 +18      ; Fill in CALLBACKTYPE multiple

 +19       SET XU8I=4

FOR

               SET XU8I=$ORDER(XU8DATA(XU8I))

               if XU8I=""

                   QUIT

               Begin DoDot:1

 +20               NEW XU8FDA,XU8IEN,XU8MSG,XU8TEST,XU8J,XU8FLAG

 +21      ; Check for duplicates (loop through CALLBACKTYPE for this entry)

 +22               SET XU8J=0

FOR

                       SET XU8J=$ORDER(^XWB(8994.5,XU8IENS,1,"B",$EXTRACT(XU8DATA(XU8I),1,1),XU8J))

                       if (XU8J="")!($DATA(XU8FLAG))

                           QUIT

                       Begin DoDot:2

 +23                       IF $GET(XU8DATA(XU8I))=$GET(^XWB(8994.5,XU8IENS,1,XU8J,0))

                               SET XU8FLAG=1

                       End DoDot:2

 +24               IF '$DATA(XU8FLAG)

                       Begin DoDot:2

 +25      ; CALLBACKTYPE

                           SET XU8FDA(8994.51,"+2,"_XU8IENS_",",.01)=$PIECE(XU8DATA(XU8I),"^",1)

 +26      ; CALLBACKPORT

                           SET XU8FDA(8994.51,"+2,"_XU8IENS_",",.02)=$PIECE(XU8DATA(XU8I),"^",2)

 +27      ; CALLBACKSERVER

                           SET XU8FDA(8994.51,"+2,"_XU8IENS_",",.03)=$PIECE(XU8DATA(XU8I),"^",3)

 +28      ; URLSTRING

                           SET XU8FDA(8994.51,"+2,"_XU8IENS_",",.04)=$PIECE(XU8DATA(XU8I),"^",4)

 +29                       DO UPDATE^DIE("","XU8FDA","XU8IEN","XU8MSG")

 +30                       IF $DATA(XU8MSG)

                               Begin DoDot:3

 +31                               SET XU8ERR="   **ERROR** "_$GET(XU8MSG("DIERR",1))_" Unable to update REMOTE APPLICATION "_XU8DATA(1)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +32      ;

 +33       DO CLEAN^DILF

 +34       QUIT XU8ERR

XU8PS630.m