DVBA186P ;ALB/DJS - DVBA*2.7*186 POST-INIT ROUTINE ; 8/27/13
;;2.7;AMIE;**186**;Apr 10, 1995;Build 21
;
Q ;NO DIRECT ENTRY
;
POST ; Main entry point for post-int item
; Populate VLER DAS URL parameter definitions
;
N DVBERR
S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI VLER DAS CH3 URL","https://CAPRIAuthSvrTest.domain.ext:7003/CapriProxyServlet")
D UPDMSG("DVBAB CAPRI VLER DAS CH3 URL",DVBERR)
S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI VLER DAS PROD URL","https://CAPRIAuthSvrProd.domain.ext:7003/CapriProxyServlet")
D UPDMSG("DVBAB CAPRI VLER DAS PROD URL",DVBERR)
;
POST2 ; Create record to add & update file
; This TAG adds an entry to the REMOTE APPLICATION file (#8994.5) for VLER DAS - CAPRI
N IEN,OPTNM,ARY,OPTIEN
S IEN="" F S IEN=$O(^DIC(19,IEN)) Q:IEN="" D
. S OPTNM=$P($G(^DIC(19,IEN,0)),U,1) Q:OPTNM'="DVBA CAPRI GUI" S OPTIEN=IEN
S ARY(8994.5,"?+1,",.01)="VLER DAS-CAPRI" ;Remote application name
S ARY(8994.5,"?+1,",.02)=OPTIEN ;Context option IEN FOR "DVBA CAPRI GUI"
S ARY(8994.5,"?+1,",.03)=">:6IZRxZG-axn7]oX3S" ;Application code
S ARY(8994.51,"?+2,?+1,",.01)="S" ;Callback type
S ARY(8994.51,"?+2,?+1,",.02)=-1 ;Callback port
S ARY(8994.51,"?+2,?+1,",.03)="XXX" ;Callback server
D UPDATE^DIE("","ARY","","MSG") ;Update Remote Application file with new VLER DAS-CAPRI entry
I $G(MSG("DIERR"))'="" D
.N ERR,LN,LN2
.S (ERR,LN2)=0
.F S ERR=+$O(MSG("DIERR",ERR)) Q:'ERR D
..S LN=0
..F S LN=+$O(MSG("DIERR",ERR,"TEXT",LN)) Q:'LN D
...S LN2=LN2+1
...S X(LN2)=MSG("DIERR",ERR,"TEXT",LN)
...D BMES^XPDUTL(X(LN2))
Q
;
ENXPAR(DVBENT,DVBPAR,DVBVAL) ;Update Parameter values
;
; Input:
; DVBENT - Parameter Entity
; DVBPAR - Parameter Name
; DVBVAL - Parameter Value
;
; Output:
; Function value - returns "0" on success;
; otherwise returns error#^errortext
;
N DVBERR
D EN^XPAR(DVBENT,DVBPAR,1,DVBVAL,.DVBERR)
Q DVBERR
;
UPDMSG(DVBPAR,DVBERR) ;display update message
;
; Input:
; DVBPAR - Parameter Name
; DVBERR - Parameter Update result
;
; Output: none
;
I DVBERR D
. D MES^XPDUTL(DVBPAR_" update FAILURE.")
. D MES^XPDUTL(" Failure reason: "_DVBERR)
E D
. D MES^XPDUTL(DVBPAR_" update SUCCESS.")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBA186P 2293 printed Dec 13, 2024@01:39:24 Page 2
DVBA186P ;ALB/DJS - DVBA*2.7*186 POST-INIT ROUTINE ; 8/27/13
+1 ;;2.7;AMIE;**186**;Apr 10, 1995;Build 21
+2 ;
+3 ;NO DIRECT ENTRY
QUIT
+4 ;
POST ; Main entry point for post-int item
+1 ; Populate VLER DAS URL parameter definitions
+2 ;
+3 NEW DVBERR
+4 SET DVBERR=$$ENXPAR("PKG","DVBAB CAPRI VLER DAS CH3 URL","https://CAPRIAuthSvrTest.domain.ext:7003/CapriProxyServlet")
+5 DO UPDMSG("DVBAB CAPRI VLER DAS CH3 URL",DVBERR)
+6 SET DVBERR=$$ENXPAR("PKG","DVBAB CAPRI VLER DAS PROD URL","https://CAPRIAuthSvrProd.domain.ext:7003/CapriProxyServlet")
+7 DO UPDMSG("DVBAB CAPRI VLER DAS PROD URL",DVBERR)
+8 ;
POST2 ; Create record to add & update file
+1 ; This TAG adds an entry to the REMOTE APPLICATION file (#8994.5) for VLER DAS - CAPRI
+2 NEW IEN,OPTNM,ARY,OPTIEN
+3 SET IEN=""
FOR
SET IEN=$ORDER(^DIC(19,IEN))
if IEN=""
QUIT
Begin DoDot:1
+4 SET OPTNM=$PIECE($GET(^DIC(19,IEN,0)),U,1)
if OPTNM'="DVBA CAPRI GUI"
QUIT
SET OPTIEN=IEN
End DoDot:1
+5 ;Remote application name
SET ARY(8994.5,"?+1,",.01)="VLER DAS-CAPRI"
+6 ;Context option IEN FOR "DVBA CAPRI GUI"
SET ARY(8994.5,"?+1,",.02)=OPTIEN
+7 ;Application code
SET ARY(8994.5,"?+1,",.03)=">:6IZRxZG-axn7]oX3S"
+8 ;Callback type
SET ARY(8994.51,"?+2,?+1,",.01)="S"
+9 ;Callback port
SET ARY(8994.51,"?+2,?+1,",.02)=-1
+10 ;Callback server
SET ARY(8994.51,"?+2,?+1,",.03)="XXX"
+11 ;Update Remote Application file with new VLER DAS-CAPRI entry
DO UPDATE^DIE("","ARY","","MSG")
+12 IF $GET(MSG("DIERR"))'=""
Begin DoDot:1
+13 NEW ERR,LN,LN2
+14 SET (ERR,LN2)=0
+15 FOR
SET ERR=+$ORDER(MSG("DIERR",ERR))
if 'ERR
QUIT
Begin DoDot:2
+16 SET LN=0
+17 FOR
SET LN=+$ORDER(MSG("DIERR",ERR,"TEXT",LN))
if 'LN
QUIT
Begin DoDot:3
+18 SET LN2=LN2+1
+19 SET X(LN2)=MSG("DIERR",ERR,"TEXT",LN)
+20 DO BMES^XPDUTL(X(LN2))
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
ENXPAR(DVBENT,DVBPAR,DVBVAL) ;Update Parameter values
+1 ;
+2 ; Input:
+3 ; DVBENT - Parameter Entity
+4 ; DVBPAR - Parameter Name
+5 ; DVBVAL - Parameter Value
+6 ;
+7 ; Output:
+8 ; Function value - returns "0" on success;
+9 ; otherwise returns error#^errortext
+10 ;
+11 NEW DVBERR
+12 DO EN^XPAR(DVBENT,DVBPAR,1,DVBVAL,.DVBERR)
+13 QUIT DVBERR
+14 ;
UPDMSG(DVBPAR,DVBERR) ;display update message
+1 ;
+2 ; Input:
+3 ; DVBPAR - Parameter Name
+4 ; DVBERR - Parameter Update result
+5 ;
+6 ; Output: none
+7 ;
+8 IF DVBERR
Begin DoDot:1
+9 DO MES^XPDUTL(DVBPAR_" update FAILURE.")
+10 DO MES^XPDUTL(" Failure reason: "_DVBERR)
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 DO MES^XPDUTL(DVBPAR_" update SUCCESS.")
End DoDot:1
+13 QUIT
+14 ;
