DVBAP219 ;ALB/DBE - CAPRI REMOTE APPLICATION FILE UPDATE ; 3/9/2020
;;2.7;AMIE;**219**;Apr 10, 1995;Build 3
;
; Post-init routine updating CALLBACKSERVER (.03) field of
; the CAPRI entry in the REMOTE APPLICATION (#8994.5) file
;
Q
;
EN ;routine entry point
D UPDATE ;update capri callbackserver in remote application (#8994.5) file
D BMES^XPDUTL("Update complete.")
;
Q
;
UPDATE ;updating capri callbackserver entry
;
N DVBAIEN,DVBAERR,DVBAFDA,DVBASUBF,DVBASUBI ;dvbasubf=subfile, dvbasubi=subfile entry ien
;
D MES^XPDUTL(">>>Updating CAPRI entry in REMOTE APPLICATION (#8994.5) file...")
;
S DVBAIEN=0 F S DVBAIEN=$O(^XWB(8994.5,"B","CAPRI",DVBAIEN)) Q:'DVBAIEN D ;identify capri entry ien(s)
.S DVBASUBI=0 F S DVBASUBI=$O(^XWB(8994.5,DVBAIEN,1,"B","R",DVBASUBI)) Q:'DVBASUBI D ;only use rpc-broker ("R") subfile ien(s)
..I $P(^XWB(8994.5,DVBAIEN,1,DVBASUBI,0),U,3)="DOMAIN.EXT" D
...S DVBASUBF="8994.51" ;callbacktype subfile number
...S DVBAFDA(DVBASUBF,DVBASUBI_","_DVBAIEN_",",.03)="claims.domain.ext" ;fda format (subfile,subfile ien,parent file ien,field)
...K DVBAERR D FILE^DIE(,"DVBAFDA","DVBAERR")
...I '$D(DVBAERR) D BMES^XPDUTL(" >>>....CAPRI entry (IEN #"_DVBAIEN_") updated successfully")
...I $D(DVBAERR) D BMES^XPDUTL(" >>>....Error updating CAPRI entry (IEN #"_DVBAIEN_")") D
....D MES^XPDUTL(" ERROR: "_DVBAERR("DIERR","1")) ;print error code to help identify filing issue
....D BMES^XPDUTL(" *** Please contact support for assistance. ***")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAP219 1554 printed Sep 23, 2025@19:17:28 Page 2
DVBAP219 ;ALB/DBE - CAPRI REMOTE APPLICATION FILE UPDATE ; 3/9/2020
+1 ;;2.7;AMIE;**219**;Apr 10, 1995;Build 3
+2 ;
+3 ; Post-init routine updating CALLBACKSERVER (.03) field of
+4 ; the CAPRI entry in the REMOTE APPLICATION (#8994.5) file
+5 ;
+6 QUIT
+7 ;
EN ;routine entry point
+1 ;update capri callbackserver in remote application (#8994.5) file
DO UPDATE
+2 DO BMES^XPDUTL("Update complete.")
+3 ;
+4 QUIT
+5 ;
UPDATE ;updating capri callbackserver entry
+1 ;
+2 ;dvbasubf=subfile, dvbasubi=subfile entry ien
NEW DVBAIEN,DVBAERR,DVBAFDA,DVBASUBF,DVBASUBI
+3 ;
+4 DO MES^XPDUTL(">>>Updating CAPRI entry in REMOTE APPLICATION (#8994.5) file...")
+5 ;
+6 ;identify capri entry ien(s)
SET DVBAIEN=0
FOR
SET DVBAIEN=$ORDER(^XWB(8994.5,"B","CAPRI",DVBAIEN))
if 'DVBAIEN
QUIT
Begin DoDot:1
+7 ;only use rpc-broker ("R") subfile ien(s)
SET DVBASUBI=0
FOR
SET DVBASUBI=$ORDER(^XWB(8994.5,DVBAIEN,1,"B","R",DVBASUBI))
if 'DVBASUBI
QUIT
Begin DoDot:2
+8 IF $PIECE(^XWB(8994.5,DVBAIEN,1,DVBASUBI,0),U,3)="DOMAIN.EXT"
Begin DoDot:3
+9 ;callbacktype subfile number
SET DVBASUBF="8994.51"
+10 ;fda format (subfile,subfile ien,parent file ien,field)
SET DVBAFDA(DVBASUBF,DVBASUBI_","_DVBAIEN_",",.03)="claims.domain.ext"
+11 KILL DVBAERR
DO FILE^DIE(,"DVBAFDA","DVBAERR")
+12 IF '$DATA(DVBAERR)
DO BMES^XPDUTL(" >>>....CAPRI entry (IEN #"_DVBAIEN_") updated successfully")
+13 IF $DATA(DVBAERR)
DO BMES^XPDUTL(" >>>....Error updating CAPRI entry (IEN #"_DVBAIEN_")")
Begin DoDot:4
+14 ;print error code to help identify filing issue
DO MES^XPDUTL(" ERROR: "_DVBAERR("DIERR","1"))
+15 DO BMES^XPDUTL(" *** Please contact support for assistance. ***")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
