DVBA146P ;ALB/RRA - Post Init Exam file Update ; 14 Jun 2005
;;2.7;AMIE;**146**;AUG 7,2003;Build 6
;
; This is the post-install for DVBA*2.7*146 to add relevant.
; mailgroups to the new bulletins added by this patch
;
Q
;Must be run from EN^DVBA146P
EN ;
N DVBMG,DVBIEN,DVBBLT,DA,DIE,DR,DVBI,DVBFLG,DVBX,DVBMGRP,DIC,X,Y
D BMES^XPDUTL("DVBA*2.7*146 Post Installation --")
D MES^XPDUTL(" Populating mail groups for newly added Bulletins.")
D MES^XPDUTL(" ")
F DVBI="DVBA C 2507 CANCELLATION","DVBA C NEW C&P VETERAN" N DVBMG D FIND(DVBI,.DVBMG) D UPDATE
D BMES^XPDUTL("DVBA*2.7*146 Post Installation complete!")
Q
FIND(DVBI,DVBMG) ;FIND IEN'S OF MAIL GROUPS
S DVBMG=$O(^XMB(3.8,"B",DVBI,0))
D:'DVBMG MES^XPDUTL("The "_DVBI_" MAIL group does not exist")
Q
;
UPDATE ;UPDATE THE BULLETIN FILE (#3.6) ENTRIES WITH MAIL GROUPS
Q:'DVBMG
I DVBI="DVBA C 2507 CANCELLATION" S DVBBLT="DVBA CAPRI 2507 CANCELLATION"
I DVBI="DVBA C NEW C&P VETERAN" S DVBBLT="DVBA CAPRI NEW C&P VETERAN"
S DVBIEN=$O(^XMB(3.6,"B",DVBBLT,0))
Q:'DVBIEN
N DVBFLG D CHECK(DVBIEN,.DVBFLG)
;if it found a match quit because the bulletin already has the
;correct mail group
Q:DVBFLG=1
;no match found, now update the bulletin with the correct mailgroup
S DA(1)=DVBIEN,DIC="^XMB(3.6,"_DA(1)_",2,",X=DVBMG,DIC("P")=3.62,DIC(0)="X" D FILE^DICN
D:Y>0 BMES^XPDUTL("The "_DVBBLT_" bulletin has been updated.")
Q
;
CHECK(DVBIEN,DVBFLG) ;check to see if the mailgroup has already been added
S DVBFLG=0
I $D(^XMB(3.6,DVBIEN,2)) D
.S DVBX=0
.F S DVBX=$O(^XMB(3.6,DVBIEN,2,DVBX)) Q:DVBX="" Q:DVBFLG=1 D
..S DVBMGRP=$P($G(^XMB(3.6,DVBIEN,2,DVBX,0)),"^")
..I DVBMGRP=DVBMG S DVBFLG=1 D BMES^XPDUTL("The "_DVBBLT_" bulletin has already been updated!")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBA146P 1793 printed Sep 23, 2025@19:15:01 Page 2
DVBA146P ;ALB/RRA - Post Init Exam file Update ; 14 Jun 2005
+1 ;;2.7;AMIE;**146**;AUG 7,2003;Build 6
+2 ;
+3 ; This is the post-install for DVBA*2.7*146 to add relevant.
+4 ; mailgroups to the new bulletins added by this patch
+5 ;
+6 QUIT
+7 ;Must be run from EN^DVBA146P
EN ;
+1 NEW DVBMG,DVBIEN,DVBBLT,DA,DIE,DR,DVBI,DVBFLG,DVBX,DVBMGRP,DIC,X,Y
+2 DO BMES^XPDUTL("DVBA*2.7*146 Post Installation --")
+3 DO MES^XPDUTL(" Populating mail groups for newly added Bulletins.")
+4 DO MES^XPDUTL(" ")
+5 FOR DVBI="DVBA C 2507 CANCELLATION","DVBA C NEW C&P VETERAN"
NEW DVBMG
DO FIND(DVBI,.DVBMG)
DO UPDATE
+6 DO BMES^XPDUTL("DVBA*2.7*146 Post Installation complete!")
+7 QUIT
FIND(DVBI,DVBMG) ;FIND IEN'S OF MAIL GROUPS
+1 SET DVBMG=$ORDER(^XMB(3.8,"B",DVBI,0))
+2 if 'DVBMG
DO MES^XPDUTL("The "_DVBI_" MAIL group does not exist")
+3 QUIT
+4 ;
UPDATE ;UPDATE THE BULLETIN FILE (#3.6) ENTRIES WITH MAIL GROUPS
+1 if 'DVBMG
QUIT
+2 IF DVBI="DVBA C 2507 CANCELLATION"
SET DVBBLT="DVBA CAPRI 2507 CANCELLATION"
+3 IF DVBI="DVBA C NEW C&P VETERAN"
SET DVBBLT="DVBA CAPRI NEW C&P VETERAN"
+4 SET DVBIEN=$ORDER(^XMB(3.6,"B",DVBBLT,0))
+5 if 'DVBIEN
QUIT
+6 NEW DVBFLG
DO CHECK(DVBIEN,.DVBFLG)
+7 ;if it found a match quit because the bulletin already has the
+8 ;correct mail group
+9 if DVBFLG=1
QUIT
+10 ;no match found, now update the bulletin with the correct mailgroup
+11 SET DA(1)=DVBIEN
SET DIC="^XMB(3.6,"_DA(1)_",2,"
SET X=DVBMG
SET DIC("P")=3.62
SET DIC(0)="X"
DO FILE^DICN
+12 if Y>0
DO BMES^XPDUTL("The "_DVBBLT_" bulletin has been updated.")
+13 QUIT
+14 ;
CHECK(DVBIEN,DVBFLG) ;check to see if the mailgroup has already been added
+1 SET DVBFLG=0
+2 IF $DATA(^XMB(3.6,DVBIEN,2))
Begin DoDot:1
+3 SET DVBX=0
+4 FOR
SET DVBX=$ORDER(^XMB(3.6,DVBIEN,2,DVBX))
if DVBX=""
QUIT
if DVBFLG=1
QUIT
Begin DoDot:2
+5 SET DVBMGRP=$PIECE($GET(^XMB(3.6,DVBIEN,2,DVBX,0)),"^")
+6 IF DVBMGRP=DVBMG
SET DVBFLG=1
DO BMES^XPDUTL("The "_DVBBLT_" bulletin has already been updated!")
End DoDot:2
End DoDot:1
+7 QUIT
