DVBAP219.m

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 ---DVBAP219   1554     printed  Apr 09, 2024@20:46:18                                                                                                                                                                                                    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