DVBA146P.m

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 ---DVBA146P   1793     printed  Mar 13, 2025@20:43:42                                                                                                                                                                                                    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