XU8P702 ;ISF/CLG - Post-Install for 702 ;04/28/17 11:56
;;8.0;KERNEL;**702**;Jul 10, 1995;Build 19
;Per VA Directive 6402, this routine should not be modified.
; Post Installation Routine for patch XU*8.0*702
;
; Installs entries into the REMOTE APPLICATION file (#8994.5)
;
; Removes entries from the REMOTE APPLICATION file (#8994.5)
; that were installed with Entered in Error Patch XU*8.0*681
;
; EXTERNAL REFERENCES
; BMES^XPDUTL 10141
; $$FIND1^DIC
; UPDATE^DIE 2053
;
MAIN ; Control subroutine
N XU8ERRX,XU8DATA
;
; "TERMINAL EMULATOR" to record terminal emulator access (LOA=2) in the SIGN-ON LOG
K XU8DATA
S XU8DATA(1)="TERMINAL EMULATOR" ; Name
S XU8DATA(4)="general_terminal_emulator/loa2avcodes" ; Security phrase (case sensitive), non-application specific
S XU8DATA(5)="S"_"^"_"-1"_"^"_""_"^"_""
S XU8ERRX=$$CREATE(.XU8DATA) ; Create REMOTE APPLICATION entry
D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Success message" or "Error text"
;
; "MICRO FOCUS REFLECTION" to record Micro Focus Reflection access in the SIGN-ON LOG
K XU8DATA
S XU8DATA(1)="MICRO FOCUS REFLECTION" ; Name
S XU8DATA(4)="delphi_rpc_broker/attachmate.emulation.frame.exe" ; Security phrase (case sensitive)
S XU8DATA(5)="S"_"^"_"-1"_"^"_""_"^"_""
S XU8ERRX=$$CREATE(.XU8DATA) ; Create REMOTE APPLICATION entry
D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Success message" or "Error text"
;
; "ATTACHMATE REFLECTION" created with Patch XU*8.0*681, being removed with XU*8.0*702
K XU8DATA
S XU8DATA(1)="ATTACHMATE REFLECTION" ; Name
S XU8ERRX=$$CLNUP(.XU8DATA) ; Create REMOTE APPLICATION entry
D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Removal success message" or "Blank if no entry exists"
;
; "CPRS GUI" created with Patch XU*8.0*681, being removed with XU*8.0*702
K XU8DATA
S XU8DATA(1)="CPRS GUI" ; Name
S XU8ERRX=$$CLNUP(.XU8DATA) ; Remove REMOTE APPLICATION
D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Removal success message" or "Blank if no entry exists"
;
; "BCMA GUI" created with Patch XU*8.0*681, being removed with XU*8.0*702
K XU8DATA
S XU8DATA(1)="BCMA GUI" ; Name
S XU8ERRX=$$CLNUP(.XU8DATA) ; Remove REMOTE APPLICATION
D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Removal success message" or "Blank if no entry exists"
;
; "DSS ROI" created with Patch XU*8.0*681, being removed with XU*8.0*702
K XU8DATA
S XU8DATA(1)="DSS ROI" ; Name
S XU8ERRX=$$CLNUP(.XU8DATA) ; Remove REMOTE APPLICATION
I XU8ERRX'="" D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Removal success message" or "Blank if no entry exists"
;
Q
;
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
CLNUP(XU8DATA) ; Clean up REMOTE APPLICATION entries from Patch XU*8.0*681 (if they exist)
N XU8ERR,XU8IEN,DA,DIK
S XU8ERR=""
S XU8IEN=$$FIND1^DIC(8994.5,"","X",XU8DATA(1),"B")
I $G(XU8IEN)>0 D
. S DIK="^XWB(8994.5,",DA=XU8IEN
. D ^DIK
. S XU8ERR=" REMOTE APPLICATION entry removed: "_XU8DATA(1)
. K XU8IEN
D CLEAN^DILF
Q XU8ERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P702 5408 printed Apr 09, 2024@21:17:32 Page 2
XU8P702 ;ISF/CLG - Post-Install for 702 ;04/28/17 11:56
+1 ;;8.0;KERNEL;**702**;Jul 10, 1995;Build 19
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ; Post Installation Routine for patch XU*8.0*702
+4 ;
+5 ; Installs entries into the REMOTE APPLICATION file (#8994.5)
+6 ;
+7 ; Removes entries from the REMOTE APPLICATION file (#8994.5)
+8 ; that were installed with Entered in Error Patch XU*8.0*681
+9 ;
+10 ; EXTERNAL REFERENCES
+11 ; BMES^XPDUTL 10141
+12 ; $$FIND1^DIC
+13 ; UPDATE^DIE 2053
+14 ;
MAIN ; Control subroutine
+1 NEW XU8ERRX,XU8DATA
+2 ;
+3 ; "TERMINAL EMULATOR" to record terminal emulator access (LOA=2) in the SIGN-ON LOG
+4 KILL XU8DATA
+5 ; Name
SET XU8DATA(1)="TERMINAL EMULATOR"
+6 ; Security phrase (case sensitive), non-application specific
SET XU8DATA(4)="general_terminal_emulator/loa2avcodes"
+7 SET XU8DATA(5)="S"_"^"_"-1"_"^"_""_"^"_""
+8 ; Create REMOTE APPLICATION entry
SET XU8ERRX=$$CREATE(.XU8DATA)
+9 ; XU8ERRX is "Success message" or "Error text"
DO BMES^XPDUTL(XU8ERRX)
+10 ;
+11 ; "MICRO FOCUS REFLECTION" to record Micro Focus Reflection access in the SIGN-ON LOG
+12 KILL XU8DATA
+13 ; Name
SET XU8DATA(1)="MICRO FOCUS REFLECTION"
+14 ; Security phrase (case sensitive)
SET XU8DATA(4)="delphi_rpc_broker/attachmate.emulation.frame.exe"
+15 SET XU8DATA(5)="S"_"^"_"-1"_"^"_""_"^"_""
+16 ; Create REMOTE APPLICATION entry
SET XU8ERRX=$$CREATE(.XU8DATA)
+17 ; XU8ERRX is "Success message" or "Error text"
DO BMES^XPDUTL(XU8ERRX)
+18 ;
+19 ; "ATTACHMATE REFLECTION" created with Patch XU*8.0*681, being removed with XU*8.0*702
+20 KILL XU8DATA
+21 ; Name
SET XU8DATA(1)="ATTACHMATE REFLECTION"
+22 ; Create REMOTE APPLICATION entry
SET XU8ERRX=$$CLNUP(.XU8DATA)
+23 ; XU8ERRX is "Removal success message" or "Blank if no entry exists"
DO BMES^XPDUTL(XU8ERRX)
+24 ;
+25 ; "CPRS GUI" created with Patch XU*8.0*681, being removed with XU*8.0*702
+26 KILL XU8DATA
+27 ; Name
SET XU8DATA(1)="CPRS GUI"
+28 ; Remove REMOTE APPLICATION
SET XU8ERRX=$$CLNUP(.XU8DATA)
+29 ; XU8ERRX is "Removal success message" or "Blank if no entry exists"
DO BMES^XPDUTL(XU8ERRX)
+30 ;
+31 ; "BCMA GUI" created with Patch XU*8.0*681, being removed with XU*8.0*702
+32 KILL XU8DATA
+33 ; Name
SET XU8DATA(1)="BCMA GUI"
+34 ; Remove REMOTE APPLICATION
SET XU8ERRX=$$CLNUP(.XU8DATA)
+35 ; XU8ERRX is "Removal success message" or "Blank if no entry exists"
DO BMES^XPDUTL(XU8ERRX)
+36 ;
+37 ; "DSS ROI" created with Patch XU*8.0*681, being removed with XU*8.0*702
+38 KILL XU8DATA
+39 ; Name
SET XU8DATA(1)="DSS ROI"
+40 ; Remove REMOTE APPLICATION
SET XU8ERRX=$$CLNUP(.XU8DATA)
+41 ; XU8ERRX is "Removal success message" or "Blank if no entry exists"
IF XU8ERRX'=""
DO BMES^XPDUTL(XU8ERRX)
+42 ;
+43 QUIT
+44 ;
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
CLNUP(XU8DATA) ; Clean up REMOTE APPLICATION entries from Patch XU*8.0*681 (if they exist)
+1 NEW XU8ERR,XU8IEN,DA,DIK
+2 SET XU8ERR=""
+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 SET XU8ERR=" REMOTE APPLICATION entry removed: "_XU8DATA(1)
+8 KILL XU8IEN
End DoDot:1
+9 DO CLEAN^DILF
+10 QUIT XU8ERR
