Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XU8P810

XU8P810.m

Go to the documentation of this file. 
  1. XU8P810 ; OAK/CKU - Post-Install for 810 ; Nov 19, 2024@18:29:06
  1.  ;;8.0;KERNEL;**810**;Jul 10, 1995;Build 16
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;  Post Installation Routine for patch XU*8.0*801
  1.  ;
  1.  ;  Installs entries into the REMOTE APPLICATION file (#8994.5)
  1.  ;
  1.  ;  EXTERNAL REFERENCES
  1.  ;    BMES^XPDUTL 10141
  1.  ;    $$FIND1^DIC
  1.  ;    UPDATE^DIE 2053
  1.  ;
  1. MAIN ; Control subroutine
  1.  N XU8ERRX,XU8DATA
  1.  ;
  1.  ; "XU PKI ORR" to record Micro Focus Reflection access in the SIGN-ON LOG
  1.  K XU8DATA
  1.  S XU8DATA(1)="XU PKI ORR" ; Name
  1.  S XU8DATA(2)="XUS SIGNON" ; Context Option
  1.  S XU8DATA(4)="u25/Zyg8BBX10821WSQ1ZFZZysVm9hWJSdMDikAjQ1o=" ; Security phrase (already hashed using sha256)
  1.  S XU8DATA(5)="S"_"^"_"-1"_"^"_""_"^"_""
  1.  S XU8ERRX=$$CREATE(.XU8DATA) ; Create REMOTE APPLICATION entry
  1.  D BMES^XPDUTL(XU8ERRX) ; XU8ERRX is "Success message" or "Error text"
  1.  ;
  1.  Q
  1.  ;
  1. OPTION(XU8DATA) ; Create CONTEXTOPTION if doesn't exist
  1.  N XU8ERR,XU8FDA,XU8IEN,XU8MSG
  1.  S XU8IEN=$$FIND1^DIC(19,"","X",XU8DATA(2),"B")
  1.  S XU8ERR="Error message: "_XU8IEN
  1.  I +XU8IEN>0 S XU8ERR="OPTION exists at IEN = "_XU8IEN
  1.  I +XU8IEN=0 S XU8ERR="OPTION "_XU8DATA(2)_" created" D
  1.  . S XU8FDA(19,"?+1,",.01)=XU8DATA(2)
  1.  . S XU8FDA(19,"?+1,",1)=XU8DATA(3)
  1.  . S XU8FDA(19,"?+1,",4)="B" ; B:Broker (Client/Server)
  1.  . D UPDATE^DIE("","XU8FDA","XU8IEN","XU8MSG")
  1.  . I $D(XU8MSG) S XU8ERR="   **ERROR** "_$G(XU8MSG("DIERR",1))_" Unable to create OPTION entry "_XU8DATA(2)
  1.  D CLEAN^DILF
  1.  Q XU8ERR
  1.  ;
  1. CREATE(XU8DATA) ; Create new REMOTE APPLICATION entry
  1.  N XU8ERR,XU8FDA,XU8IEN,XU8MSG,XU8I,XU8IENS,DA,DIK
  1.  ; Delete existing entry if it exists, before creating updated entry
  1.  S XU8IEN=$$FIND1^DIC(8994.5,"","X",XU8DATA(1),"B")
  1.  I $G(XU8IEN)>0 D
  1.  . S DIK="^XWB(8994.5,",DA=XU8IEN
  1.  . D ^DIK
  1.  . K XU8IEN
  1.  S XU8ERR="   REMOTE APPLICATION entry created: "_XU8DATA(1)
  1.  S XU8FDA(8994.5,"?+1,",.01)=XU8DATA(1) ; NAME
  1.  I $D(XU8DATA(2)) S XU8FDA(8994.5,"?+1,",.02)=$$FIND1^DIC(19,"","X",XU8DATA(2),"B") ; CONTEXTOPTION
  1.  S XU8FDA(8994.5,"?+1,",.03)=XU8DATA(4) ; APPLICATIONCODE
  1.  D UPDATE^DIE("","XU8FDA","XU8IEN","XU8MSG")
  1.  I $D(XU8MSG) D
  1.  . S XU8ERR="   **ERROR** "_$G(XU8MSG("DIERR",1))_" Unable to create REMOTE APPLICATION "_XU8DATA(1)
  1.  ; Find the REMOTE APPLICATION
  1.  S XU8IENS=$$FIND1^DIC(8994.5,"","X",XU8DATA(1),"B")
  1.  I +XU8IENS<1 S XU8ERR=XU8IENS Q XU8ERR
  1.  ; Fill in CALLBACKTYPE multiple
  1.  S XU8I=4 F  S XU8I=$O(XU8DATA(XU8I)) Q:XU8I=""  D
  1.  . N XU8FDA,XU8IEN,XU8MSG,XU8TEST,XU8J,XU8FLAG
  1.  . ; Check for duplicates (loop through CALLBACKTYPE for this entry)
  1.  . S XU8J=0 F  S XU8J=$O(^XWB(8994.5,XU8IENS,1,"B",$E(XU8DATA(XU8I),1,1),XU8J)) Q:(XU8J="")!($D(XU8FLAG))  D
  1.  . . I $G(XU8DATA(XU8I))=$G(^XWB(8994.5,XU8IENS,1,XU8J,0)) S XU8FLAG=1
  1.  . I '$D(XU8FLAG) D
  1.  . . S XU8FDA(8994.51,"+2,"_XU8IENS_",",.01)=$P(XU8DATA(XU8I),"^",1) ; CALLBACKTYPE
  1.  . . S XU8FDA(8994.51,"+2,"_XU8IENS_",",.02)=$P(XU8DATA(XU8I),"^",2) ; CALLBACKPORT
  1.  . . S XU8FDA(8994.51,"+2,"_XU8IENS_",",.03)=$P(XU8DATA(XU8I),"^",3) ; CALLBACKSERVER
  1.  . . S XU8FDA(8994.51,"+2,"_XU8IENS_",",.04)=$P(XU8DATA(XU8I),"^",4) ; URLSTRING
  1.  . . D UPDATE^DIE("","XU8FDA","XU8IEN","XU8MSG")
  1.  . . I $D(XU8MSG) D
  1.  . . . S XU8ERR="   **ERROR** "_$G(XU8MSG("DIERR",1))_" Unable to update REMOTE APPLICATION "_XU8DATA(1)
  1.  ;
  1.  D CLEAN^DILF
  1.  Q XU8ERR