XU8PS659 ;ISD/HGW - Post-Install for XU*8*659 ;12/17/15 10:49
;;8.0;KERNEL;**659**;Jul 10, 1995;Build 22
;Per VA Directive 6402, this routine should not be modified.
;
; Post Installation Routine for patch XU*8.0*659
; EXTERNAL REFERENCES
; BMES^XPDUTL 10141
; $$FIND1^DIC
; UPDATE^DIE 2053
;
MAIN ; Control subroutine
N I,XDIR,XREF,XU8DATA,XU8ERRX,Y
;
; Delete old BSE Example entries from REMOTE APPLICATION file (#8994.5)
S XU8DATA(1)="XUSBSE TEST1" ; Name
S XU8ERRX=$$DELETE(.XU8DATA) ; Delete existing REMOTE APPLICATION entry
S XU8DATA(1)="XUSBSE TEST2" ; Name
S XU8ERRX=$$DELETE(.XU8DATA) ; Delete existing REMOTE APPLICATION entry
S XU8DATA(1)="XUSBSE TEST3" ; Name
S XU8ERRX=$$DELETE(.XU8DATA) ; Delete existing REMOTE APPLICATION entry
;
; Install IAM Provisioning entry into the REMOTE APPLICATION file (#8994.5)
S XU8DATA(1)="IAM PROVISIONING" ; Name
S XU8DATA(2)="XUS IAM USER PROVISIONING" ; ContextOption Name
S XU8DATA(3)="IAM User Provisioning" ; ContextOption Menu Text
S XU8DATA(4)="put butter square hat" ; Security phrase
; For TYPE multiple, each entry should be XU8DATA(n)=CallBackType^CallBackPort^CallBackServer^URLString
; where n is 5, 6, 7, 8 etc.
S XU8DATA(5)="S^-1^N/A^N/A"
S XU8ERRX=$$OPTION(.XU8DATA) ; Create CONTEXTOPTION if doesn't exist
D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Success message" or "Error text"
S XU8ERRX=$$DELETE(.XU8DATA) ; Delete existing REMOTE APPLICATION entry
S XU8ERRX=$$CREATE(.XU8DATA) ; Create REMOTE APPLICATION entry
D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Success message" or "Error text"
;
; Install IAM Binding entry into the REMOTE APPLICATION file (#8994.5)
S XU8DATA(1)="IAM BINDING" ; Name
S XU8DATA(2)="XUS IAM USER BINDING" ; ContextOption Name
S XU8DATA(3)="IAM User Binding App" ; ContextOption Menu Text
S XU8DATA(4)="de$lAyING55AMO)BAe29" ; Security phrase
; For TYPE multiple, each entry should be XU8DATA(n)=CallBackType^CallBackPort^CallBackServer^URLString
; where n is 5, 6, 7, 8 etc.
S XU8DATA(5)="S^-1^N/A^N/A"
S XU8ERRX=$$OPTION(.XU8DATA) ; Create CONTEXTOPTION if doesn't exist
D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Success message" or "Error text"
S XU8ERRX=$$DELETE(.XU8DATA) ; Delete existing REMOTE APPLICATION entry
S XU8ERRX=$$CREATE(.XU8DATA) ; Create REMOTE APPLICATION entry
D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Success message" or "Error text"
;
; Install NUMI entry into the REMOTE APPLICATION file (#8994.5)
S XU8DATA(1)="NUMI" ; Name
S XU8DATA(2)="WEBN NATL UTIL MGMT INTEG" ; ContextOption Name
S XU8DATA(3)="National Utilization Mgmt Integration" ; ContextOption Menu Text
S XU8DATA(4)="WEBN NATL UTIL MGMT INTEG" ; Security phrase
; For TYPE multiple, each entry should be XU8DATA(n)=CallBackType^CallBackPort^CallBackServer^URLString
; where n is 5, 6, 7, 8 etc.
S XU8DATA(5)="S^-1^N/A^N/A"
S XU8ERRX=$$OPTION(.XU8DATA) ; Create CONTEXTOPTION if doesn't exist
D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Success message" or "Error text"
S XU8ERRX=$$DELETE(.XU8DATA) ; Delete existing REMOTE APPLICATION entry
S XU8ERRX=$$CREATE(.XU8DATA) ; Create REMOTE APPLICATION entry
D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Success message" or "Error text"
;
; Install BMS entry into the REMOTE APPLICATION file (#8994.5)
S XU8DATA(1)="BMS" ; Name
S XU8DATA(2)="WEBB BED MGMT SOLUTION" ; ContextOption Name
S XU8DATA(3)="Bed Management Solution" ; ContextOption Menu Text
S XU8DATA(4)="WEBB BED MGMT SOLUTION" ; Security phrase
; For TYPE multiple, each entry should be XU8DATA(n)=CallBackType^CallBackPort^CallBackServer^URLString
; where n is 5, 6, 7, 8 etc.
S XU8DATA(5)="S^-1^N/A^N/A"
S XU8ERRX=$$OPTION(.XU8DATA) ; Create CONTEXTOPTION if doesn't exist
D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Success message" or "Error text"
S XU8ERRX=$$DELETE(.XU8DATA) ; Delete existing REMOTE APPLICATION entry
S XU8ERRX=$$CREATE(.XU8DATA) ; Create REMOTE APPLICATION entry
D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Success message" or "Error text"
;
; Install entry into the DIALOG file (#.84)
;NUMBER: 30810.63 DIALOG NUMBER: 30810.63
; TYPE: GENERAL MESSAGE PACKAGE: KERNEL
; SHORT DESCRIPTION: STS token not valid.
; TEXT:
; Unable to sign on using Identity and Access Management STS token.
K XU8DATA,XU8ERRX
S XU8DATA(1)=30810.63
S XU8DATA(2)="KERNEL"
S XU8DATA(3)=2 ;"GENERAL MESSAGE"
S XU8DATA(4)="STS token not valid."
S XU8DATA(5)="Unable to sign on using Identity and Access Management STS token. Try using Access/Verify codes."
S XU8ERRX=$$NEWDIA(.XU8DATA)
D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Success message" or "Error text"
;
; Install entries into KERNEL SYSTEMS PARAMETERS file (#8989.3)
K XU8DATA,XU8ERRX
S XU8DATA(1)="eauth.domain.ext"
S XU8DATA(2)="Department Of Veterans Affairs"
S XU8DATA(3)="urn:oid:2.16.840.1.113883.4.349"
S XU8ERRX=$$NEWKSP(.XU8DATA)
D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Success message" or "Error text"
;
K ^XU8P655("VACAA") ;Cleanup after patch XU*8*655
;
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
;
DELETE(XU8DATA) ; Delete existing REMOTE APPLICATION entry
N DA,DIK,XU8IEN
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
Q 1
CREATE(XU8DATA) ; Create new REMOTE APPLICATION entry
N XU8ERR,XU8FDA,XU8I,XU8IEN,XU8IENS,XU8MSG
S XU8ERR=" REMOTE APPLICATION entry created: "_XU8DATA(1)
S XU8FDA(8994.5,"?+1,",.01)=XU8DATA(1) ; NAME
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
;
NEWDIA(XU8DATA) ; Create DIALOG entry
N DA,DIK,XU8DT,XU8ERR,XU8FDA,XU8IEN,XU8MSG
; Delete existing entry if it exists, before creating updated entry
S XU8IEN=$$FIND1^DIC(.84,"","X",XU8DATA(1),"B")
I $G(XU8IEN)>0 D
. S DIK="^DI(.84,",DA=XU8IEN
. D ^DIK
. K XU8IEN
S XU8ERR=" DIALOG entry created: "_XU8DATA(4)
S XU8IEN(1)=XU8DATA(1)
S XU8FDA(.84,"+1,",.01)=XU8DATA(1) ;IEN
S XU8FDA(.84,"+1,",1)=XU8DATA(3) ;TYPE
S XU8FDA(.84,"+1,",1.2)=XU8DATA(2) ;PACKAGE
S XU8FDA(.84,"+1,",1.3)=XU8DATA(4) ;SHORT DESCRIPTION
D UPDATE^DIE("","XU8FDA","XU8IEN","XU8MSG")
I $D(XU8MSG) S XU8ERR=" **ERROR** "_$G(XU8MSG("DIERR",1))_" Unable to create DIALOG entry: "_XU8DATA(4) D CLEAN^DILF Q XU8ERR
S XU8IEN=$$FIND1^DIC(.84,"","X",XU8DATA(1),"B")
I $G(XU8IEN)>0 D
. S XU8DT(1)=XU8DATA(5) ;TEXT
. D WP^DIE(.84,XU8IEN_",",4,,"XU8DT","XU8MSG")
I $D(XU8MSG) D
. S XU8ERR=" **ERROR** "_$G(XU8MSG("DIERR",1))_" Unable to create DIALOG entry: "_XU8DATA(4)
. S DIK="^DI(.84,",DA=XU8IEN
. D ^DIK
. K XU8IEN
D CLEAN^DILF
Q XU8ERR
;
NEWKSP(XU8DATA) ; Create KERNEL SYSTEM PARAMETERS entries
N DA,DIK,XU8ERR,XU8FDA,XU8MSG
S XU8ERR=" KERNEL SYSTEM PARAMETERS fields populated: SECURITY TOKEN SERVICE, ORGANIZATION, ORGANIZATION ID"
S XU8FDA(8989.3,"1,",200.1)=XU8DATA(1)
S XU8FDA(8989.3,"1,",200.2)=XU8DATA(2)
S XU8FDA(8989.3,"1,",200.3)=XU8DATA(3)
D FILE^DIE("E","XU8FDA","XU8MSG")
I $D(XU8MSG) D
. S XU8ERR=" **ERROR** "_$G(XU8MSG("DIERR",1))_" Unable to populate KERNEL SYSTEM PARAMETERS fields"
D CLEAN^DILF
Q XU8ERR
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8PS659 9154 printed Sep 23, 2025@19:45:02 Page 2
XU8PS659 ;ISD/HGW - Post-Install for XU*8*659 ;12/17/15 10:49
+1 ;;8.0;KERNEL;**659**;Jul 10, 1995;Build 22
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Post Installation Routine for patch XU*8.0*659
+5 ; EXTERNAL REFERENCES
+6 ; BMES^XPDUTL 10141
+7 ; $$FIND1^DIC
+8 ; UPDATE^DIE 2053
+9 ;
MAIN ; Control subroutine
+1 NEW I,XDIR,XREF,XU8DATA,XU8ERRX,Y
+2 ;
+3 ; Delete old BSE Example entries from REMOTE APPLICATION file (#8994.5)
+4 ; Name
SET XU8DATA(1)="XUSBSE TEST1"
+5 ; Delete existing REMOTE APPLICATION entry
SET XU8ERRX=$$DELETE(.XU8DATA)
+6 ; Name
SET XU8DATA(1)="XUSBSE TEST2"
+7 ; Delete existing REMOTE APPLICATION entry
SET XU8ERRX=$$DELETE(.XU8DATA)
+8 ; Name
SET XU8DATA(1)="XUSBSE TEST3"
+9 ; Delete existing REMOTE APPLICATION entry
SET XU8ERRX=$$DELETE(.XU8DATA)
+10 ;
+11 ; Install IAM Provisioning entry into the REMOTE APPLICATION file (#8994.5)
+12 ; Name
SET XU8DATA(1)="IAM PROVISIONING"
+13 ; ContextOption Name
SET XU8DATA(2)="XUS IAM USER PROVISIONING"
+14 ; ContextOption Menu Text
SET XU8DATA(3)="IAM User Provisioning"
+15 ; Security phrase
SET XU8DATA(4)="put butter square hat"
+16 ; For TYPE multiple, each entry should be XU8DATA(n)=CallBackType^CallBackPort^CallBackServer^URLString
+17 ; where n is 5, 6, 7, 8 etc.
+18 SET XU8DATA(5)="S^-1^N/A^N/A"
+19 ; Create CONTEXTOPTION if doesn't exist
SET XU8ERRX=$$OPTION(.XU8DATA)
+20 ; XU8ERRX is "Success message" or "Error text"
DO BMES^XPDUTL(XU8ERRX)
+21 ; Delete existing REMOTE APPLICATION entry
SET XU8ERRX=$$DELETE(.XU8DATA)
+22 ; Create REMOTE APPLICATION entry
SET XU8ERRX=$$CREATE(.XU8DATA)
+23 ; XU8ERRX is "Success message" or "Error text"
DO BMES^XPDUTL(XU8ERRX)
+24 ;
+25 ; Install IAM Binding entry into the REMOTE APPLICATION file (#8994.5)
+26 ; Name
SET XU8DATA(1)="IAM BINDING"
+27 ; ContextOption Name
SET XU8DATA(2)="XUS IAM USER BINDING"
+28 ; ContextOption Menu Text
SET XU8DATA(3)="IAM User Binding App"
+29 ; Security phrase
SET XU8DATA(4)="de$lAyING55AMO)BAe29"
+30 ; For TYPE multiple, each entry should be XU8DATA(n)=CallBackType^CallBackPort^CallBackServer^URLString
+31 ; where n is 5, 6, 7, 8 etc.
+32 SET XU8DATA(5)="S^-1^N/A^N/A"
+33 ; Create CONTEXTOPTION if doesn't exist
SET XU8ERRX=$$OPTION(.XU8DATA)
+34 ; XU8ERRX is "Success message" or "Error text"
DO BMES^XPDUTL(XU8ERRX)
+35 ; Delete existing REMOTE APPLICATION entry
SET XU8ERRX=$$DELETE(.XU8DATA)
+36 ; Create REMOTE APPLICATION entry
SET XU8ERRX=$$CREATE(.XU8DATA)
+37 ; XU8ERRX is "Success message" or "Error text"
DO BMES^XPDUTL(XU8ERRX)
+38 ;
+39 ; Install NUMI entry into the REMOTE APPLICATION file (#8994.5)
+40 ; Name
SET XU8DATA(1)="NUMI"
+41 ; ContextOption Name
SET XU8DATA(2)="WEBN NATL UTIL MGMT INTEG"
+42 ; ContextOption Menu Text
SET XU8DATA(3)="National Utilization Mgmt Integration"
+43 ; Security phrase
SET XU8DATA(4)="WEBN NATL UTIL MGMT INTEG"
+44 ; For TYPE multiple, each entry should be XU8DATA(n)=CallBackType^CallBackPort^CallBackServer^URLString
+45 ; where n is 5, 6, 7, 8 etc.
+46 SET XU8DATA(5)="S^-1^N/A^N/A"
+47 ; Create CONTEXTOPTION if doesn't exist
SET XU8ERRX=$$OPTION(.XU8DATA)
+48 ; XU8ERRX is "Success message" or "Error text"
DO BMES^XPDUTL(XU8ERRX)
+49 ; Delete existing REMOTE APPLICATION entry
SET XU8ERRX=$$DELETE(.XU8DATA)
+50 ; Create REMOTE APPLICATION entry
SET XU8ERRX=$$CREATE(.XU8DATA)
+51 ; XU8ERRX is "Success message" or "Error text"
DO BMES^XPDUTL(XU8ERRX)
+52 ;
+53 ; Install BMS entry into the REMOTE APPLICATION file (#8994.5)
+54 ; Name
SET XU8DATA(1)="BMS"
+55 ; ContextOption Name
SET XU8DATA(2)="WEBB BED MGMT SOLUTION"
+56 ; ContextOption Menu Text
SET XU8DATA(3)="Bed Management Solution"
+57 ; Security phrase
SET XU8DATA(4)="WEBB BED MGMT SOLUTION"
+58 ; For TYPE multiple, each entry should be XU8DATA(n)=CallBackType^CallBackPort^CallBackServer^URLString
+59 ; where n is 5, 6, 7, 8 etc.
+60 SET XU8DATA(5)="S^-1^N/A^N/A"
+61 ; Create CONTEXTOPTION if doesn't exist
SET XU8ERRX=$$OPTION(.XU8DATA)
+62 ; XU8ERRX is "Success message" or "Error text"
DO BMES^XPDUTL(XU8ERRX)
+63 ; Delete existing REMOTE APPLICATION entry
SET XU8ERRX=$$DELETE(.XU8DATA)
+64 ; Create REMOTE APPLICATION entry
SET XU8ERRX=$$CREATE(.XU8DATA)
+65 ; XU8ERRX is "Success message" or "Error text"
DO BMES^XPDUTL(XU8ERRX)
+66 ;
+67 ; Install entry into the DIALOG file (#.84)
+68 ;NUMBER: 30810.63 DIALOG NUMBER: 30810.63
+69 ; TYPE: GENERAL MESSAGE PACKAGE: KERNEL
+70 ; SHORT DESCRIPTION: STS token not valid.
+71 ; TEXT:
+72 ; Unable to sign on using Identity and Access Management STS token.
+73 KILL XU8DATA,XU8ERRX
+74 SET XU8DATA(1)=30810.63
+75 SET XU8DATA(2)="KERNEL"
+76 ;"GENERAL MESSAGE"
SET XU8DATA(3)=2
+77 SET XU8DATA(4)="STS token not valid."
+78 SET XU8DATA(5)="Unable to sign on using Identity and Access Management STS token. Try using Access/Verify codes."
+79 SET XU8ERRX=$$NEWDIA(.XU8DATA)
+80 ; XU8ERRX is "Success message" or "Error text"
DO BMES^XPDUTL(XU8ERRX)
+81 ;
+82 ; Install entries into KERNEL SYSTEMS PARAMETERS file (#8989.3)
+83 KILL XU8DATA,XU8ERRX
+84 SET XU8DATA(1)="eauth.domain.ext"
+85 SET XU8DATA(2)="Department Of Veterans Affairs"
+86 SET XU8DATA(3)="urn:oid:2.16.840.1.113883.4.349"
+87 SET XU8ERRX=$$NEWKSP(.XU8DATA)
+88 ; XU8ERRX is "Success message" or "Error text"
DO BMES^XPDUTL(XU8ERRX)
+89 ;
+90 ;Cleanup after patch XU*8*655
KILL ^XU8P655("VACAA")
+91 ;
+92 QUIT
+93 ;
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 ;
DELETE(XU8DATA) ; Delete existing REMOTE APPLICATION entry
+1 NEW DA,DIK,XU8IEN
+2 SET XU8IEN=$$FIND1^DIC(8994.5,"","X",XU8DATA(1),"B")
+3 IF $GET(XU8IEN)>0
Begin DoDot:1
+4 SET DIK="^XWB(8994.5,"
SET DA=XU8IEN
+5 DO ^DIK
+6 KILL XU8IEN
End DoDot:1
+7 QUIT 1
CREATE(XU8DATA) ; Create new REMOTE APPLICATION entry
+1 NEW XU8ERR,XU8FDA,XU8I,XU8IEN,XU8IENS,XU8MSG
+2 SET XU8ERR=" REMOTE APPLICATION entry created: "_XU8DATA(1)
+3 ; NAME
SET XU8FDA(8994.5,"?+1,",.01)=XU8DATA(1)
+4 ; CONTEXTOPTION
SET XU8FDA(8994.5,"?+1,",.02)=$$FIND1^DIC(19,"","X",XU8DATA(2),"B")
+5 ; APPLICATIONCODE
SET XU8FDA(8994.5,"?+1,",.03)=$$SHAHASH^XUSHSH(256,XU8DATA(4),"B")
+6 DO UPDATE^DIE("","XU8FDA","XU8IEN","XU8MSG")
+7 IF $DATA(XU8MSG)
Begin DoDot:1
+8 SET XU8ERR=" **ERROR** "_$GET(XU8MSG("DIERR",1))_" Unable to create REMOTE APPLICATION: "_XU8DATA(1)
End DoDot:1
+9 ; Find the REMOTE APPLICATION
+10 SET XU8IENS=$$FIND1^DIC(8994.5,"","X",XU8DATA(1),"B")
+11 IF +XU8IENS<1
SET XU8ERR=XU8IENS
QUIT XU8ERR
+12 ; Fill in CALLBACKTYPE multiple
+13 SET XU8I=4
FOR
SET XU8I=$ORDER(XU8DATA(XU8I))
if XU8I=""
QUIT
Begin DoDot:1
+14 NEW XU8FDA,XU8IEN,XU8MSG,XU8TEST,XU8J,XU8FLAG
+15 ; Check for duplicates (loop through CALLBACKTYPE for this entry)
+16 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
+17 IF $GET(XU8DATA(XU8I))=$GET(^XWB(8994.5,XU8IENS,1,XU8J,0))
SET XU8FLAG=1
End DoDot:2
+18 IF '$DATA(XU8FLAG)
Begin DoDot:2
+19 ; CALLBACKTYPE
SET XU8FDA(8994.51,"+2,"_XU8IENS_",",.01)=$PIECE(XU8DATA(XU8I),"^",1)
+20 ; CALLBACKPORT
SET XU8FDA(8994.51,"+2,"_XU8IENS_",",.02)=$PIECE(XU8DATA(XU8I),"^",2)
+21 ; CALLBACKSERVER
SET XU8FDA(8994.51,"+2,"_XU8IENS_",",.03)=$PIECE(XU8DATA(XU8I),"^",3)
+22 ; URLSTRING
SET XU8FDA(8994.51,"+2,"_XU8IENS_",",.04)=$PIECE(XU8DATA(XU8I),"^",4)
+23 DO UPDATE^DIE("","XU8FDA","XU8IEN","XU8MSG")
+24 IF $DATA(XU8MSG)
Begin DoDot:3
+25 SET XU8ERR=" **ERROR** "_$GET(XU8MSG("DIERR",1))_" Unable to update REMOTE APPLICATION: "_XU8DATA(1)
End DoDot:3
End DoDot:2
End DoDot:1
+26 ;
+27 DO CLEAN^DILF
+28 QUIT XU8ERR
+29 ;
NEWDIA(XU8DATA) ; Create DIALOG entry
+1 NEW DA,DIK,XU8DT,XU8ERR,XU8FDA,XU8IEN,XU8MSG
+2 ; Delete existing entry if it exists, before creating updated entry
+3 SET XU8IEN=$$FIND1^DIC(.84,"","X",XU8DATA(1),"B")
+4 IF $GET(XU8IEN)>0
Begin DoDot:1
+5 SET DIK="^DI(.84,"
SET DA=XU8IEN
+6 DO ^DIK
+7 KILL XU8IEN
End DoDot:1
+8 SET XU8ERR=" DIALOG entry created: "_XU8DATA(4)
+9 SET XU8IEN(1)=XU8DATA(1)
+10 ;IEN
SET XU8FDA(.84,"+1,",.01)=XU8DATA(1)
+11 ;TYPE
SET XU8FDA(.84,"+1,",1)=XU8DATA(3)
+12 ;PACKAGE
SET XU8FDA(.84,"+1,",1.2)=XU8DATA(2)
+13 ;SHORT DESCRIPTION
SET XU8FDA(.84,"+1,",1.3)=XU8DATA(4)
+14 DO UPDATE^DIE("","XU8FDA","XU8IEN","XU8MSG")
+15 IF $DATA(XU8MSG)
SET XU8ERR=" **ERROR** "_$GET(XU8MSG("DIERR",1))_" Unable to create DIALOG entry: "_XU8DATA(4)
DO CLEAN^DILF
QUIT XU8ERR
+16 SET XU8IEN=$$FIND1^DIC(.84,"","X",XU8DATA(1),"B")
+17 IF $GET(XU8IEN)>0
Begin DoDot:1
+18 ;TEXT
SET XU8DT(1)=XU8DATA(5)
+19 DO WP^DIE(.84,XU8IEN_",",4,,"XU8DT","XU8MSG")
End DoDot:1
+20 IF $DATA(XU8MSG)
Begin DoDot:1
+21 SET XU8ERR=" **ERROR** "_$GET(XU8MSG("DIERR",1))_" Unable to create DIALOG entry: "_XU8DATA(4)
+22 SET DIK="^DI(.84,"
SET DA=XU8IEN
+23 DO ^DIK
+24 KILL XU8IEN
End DoDot:1
+25 DO CLEAN^DILF
+26 QUIT XU8ERR
+27 ;
NEWKSP(XU8DATA) ; Create KERNEL SYSTEM PARAMETERS entries
+1 NEW DA,DIK,XU8ERR,XU8FDA,XU8MSG
+2 SET XU8ERR=" KERNEL SYSTEM PARAMETERS fields populated: SECURITY TOKEN SERVICE, ORGANIZATION, ORGANIZATION ID"
+3 SET XU8FDA(8989.3,"1,",200.1)=XU8DATA(1)
+4 SET XU8FDA(8989.3,"1,",200.2)=XU8DATA(2)
+5 SET XU8FDA(8989.3,"1,",200.3)=XU8DATA(3)
+6 DO FILE^DIE("E","XU8FDA","XU8MSG")
+7 IF $DATA(XU8MSG)
Begin DoDot:1
+8 SET XU8ERR=" **ERROR** "_$GET(XU8MSG("DIERR",1))_" Unable to populate KERNEL SYSTEM PARAMETERS fields"
End DoDot:1
+9 DO CLEAN^DILF
+10 QUIT XU8ERR
+11 ;
