BMCPOST1.m

BMCPOST1 ; IHS/PHXAO/TMJ - Install Mail Groups ;

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 ;

START ;Install Each Mail Group

 D CHS,IHS,OTHER,INHOUSE

 D END

 Q

CHS ;Install BMC CHS ALERT Mail Group

 Q:$D(^XMB(3.8,"B","BMC CHS ALERT"))

 S X="BMC CHS ALERT",DIC="^XMB(3.8,",DIC(0)="L",DIADD=1,DLAYGO=3.8 D ^DIC K DIC,DA,DR,DIADD,DLAYGO,DO

 I Y=-1 W !!,"Error in Creating Mail Group",!! Q

 S BMCBULL=+Y

 S DIE="^XMB(3.8,",DA=BMCBULL,DR="4////PUBLIC;3///A Bulletin is sent when a CHS Type Referral is entered;7////N;5////"_DUZ D ^DIE K DIE,DA,DR,DIU,DIY,DIW,DIV

 I $D(Y) W !!,"Error in updating CHS Mail Group",!!

 Q

 ;

IHS ;Install BMC IHS ALERT Mail Group

 Q:$D(^XMB(3.8,"B","BMC IHS ALERT"))

 S X="BMC IHS ALERT",DIC="^XMB(3.8,",DIC(0)="L",DIADD=1,DLAYGO=3.8 D ^DIC K DIC,DA,DR,DIADD,DLAYGO,DO

 I Y=-1 W !!,"Error in Creating Mail Group",!! Q

 S BMCBULL=+Y

 S DIE="^XMB(3.8,",DA=BMCBULL,DR="4////PUBLIC;3///A Bulletin is sent when a IHS Type Referral is entered;7////N;5////"_DUZ D ^DIE K DIE,DA,DR,DIU,DIY,DIW,DIV

 I $D(Y) W !!,"Error in updating IHS Mail Group",!!

 Q

 ;

OTHER ;Install BMC OTHER ALERT Mail Group

 ;

 Q:$D(^XMB(3.8,"B","BMC OTHER ALERT"))

 S X="BMC OTHER ALERT",DIC="^XMB(3.8,",DIC(0)="L",DIADD=1,DLAYGO=3.8 D ^DIC K DIC,DA,DR,DIADD,DLAYGO,DO

 I Y=-1 W !!,"Error in Creating Mail Group",!! Q

 S BMCBULL=+Y

 S DIE="^XMB(3.8,",DA=BMCBULL,DR="4////PUBLIC;3///A Bulletin is sent when a OTHER Type Referral is entered;7////N;5////"_DUZ D ^DIE K DIE,DA,DR,DIU,DIY,DIW,DIV

 I $D(Y) W !!,"Error in updating OTHER Mail Group",!!

 Q

INHOUSE ;Install BMC INHOUSE ALERT Mail Group

 Q:$D(^XMB(3.8,"B","BMC INHOUSE ALERT"))

 S X="BMC INHOUSE ALERT",DIC="^XMB(3.8,",DIC(0)="L",DIADD=1,DLAYGO=3.8 D ^DIC K DIC,DA,DR,DIADD,DLAYGO,DO

 I Y=-1 W !!,"Error in Creating Mail Group",!! Q

 S BMCBULL=+Y

 S DIE="^XMB(3.8,",DA=BMCBULL,DR="4////PUBLIC;3///A Bulletin is sent when a INHOUSE Type Referral is entered;7////N;5////"_DUZ D ^DIE K DIE,DA,DR,DIU,DIY,DIW,DIV

 I $D(Y) W !!,"Error in updating INHOUSE Mail Group",!!

 Q

 ;

END ;

 W !!,"Mail Groups Successfully Installed",!," - Now add appropriate Members to each of the following Mail Groups",!!

 W "BMC IHS ALERT",!

 W "BMC CHS ALERT",!

 W "BMC OTHER ALERT",!

 W "BMC INHOUSE ALERT",!

 K BMCBULL Q

BMCPOST1  ; IHS/PHXAO/TMJ - Install Mail Groups ;

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 +2       ;

START     ;Install Each Mail Group

 +1        DO CHS

           DO IHS

           DO OTHER

           DO INHOUSE

 +2        DO END

 +3        QUIT 

CHS       ;Install BMC CHS ALERT Mail Group

 +1        IF $DATA(^XMB(3.8,"B","BMC CHS ALERT"))

               QUIT 

 +2        SET X="BMC CHS ALERT"

           SET DIC="^XMB(3.8,"

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=3.8

           DO ^DIC

           KILL DIC,DA,DR,DIADD,DLAYGO,DO

 +3        IF Y=-1

               WRITE !!,"Error in Creating Mail Group",!!

               QUIT 

 +4        SET BMCBULL=+Y

 +5        SET DIE="^XMB(3.8,"

           SET DA=BMCBULL

           SET DR="4////PUBLIC;3///A Bulletin is sent when a CHS Type Referral is entered;7////N;5////"_DUZ

           DO ^DIE

           KILL DIE,DA,DR,DIU,DIY,DIW,DIV

 +6        IF $DATA(Y)

               WRITE !!,"Error in updating CHS Mail Group",!!

 +7        QUIT 

 +8       ;

IHS       ;Install BMC IHS ALERT Mail Group

 +1        IF $DATA(^XMB(3.8,"B","BMC IHS ALERT"))

               QUIT 

 +2        SET X="BMC IHS ALERT"

           SET DIC="^XMB(3.8,"

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=3.8

           DO ^DIC

           KILL DIC,DA,DR,DIADD,DLAYGO,DO

 +3        IF Y=-1

               WRITE !!,"Error in Creating Mail Group",!!

               QUIT 

 +4        SET BMCBULL=+Y

 +5        SET DIE="^XMB(3.8,"

           SET DA=BMCBULL

           SET DR="4////PUBLIC;3///A Bulletin is sent when a IHS Type Referral is entered;7////N;5////"_DUZ

           DO ^DIE

           KILL DIE,DA,DR,DIU,DIY,DIW,DIV

 +6        IF $DATA(Y)

               WRITE !!,"Error in updating IHS Mail Group",!!

 +7        QUIT 

 +8       ;

OTHER     ;Install BMC OTHER ALERT Mail Group

 +1       ;

 +2        IF $DATA(^XMB(3.8,"B","BMC OTHER ALERT"))

               QUIT 

 +3        SET X="BMC OTHER ALERT"

           SET DIC="^XMB(3.8,"

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=3.8

           DO ^DIC

           KILL DIC,DA,DR,DIADD,DLAYGO,DO

 +4        IF Y=-1

               WRITE !!,"Error in Creating Mail Group",!!

               QUIT 

 +5        SET BMCBULL=+Y

 +6        SET DIE="^XMB(3.8,"

           SET DA=BMCBULL

           SET DR="4////PUBLIC;3///A Bulletin is sent when a OTHER Type Referral is entered;7////N;5////"_DUZ

           DO ^DIE

           KILL DIE,DA,DR,DIU,DIY,DIW,DIV

 +7        IF $DATA(Y)

               WRITE !!,"Error in updating OTHER Mail Group",!!

 +8        QUIT 

INHOUSE   ;Install BMC INHOUSE ALERT Mail Group

 +1        IF $DATA(^XMB(3.8,"B","BMC INHOUSE ALERT"))

               QUIT 

 +2        SET X="BMC INHOUSE ALERT"

           SET DIC="^XMB(3.8,"

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=3.8

           DO ^DIC

           KILL DIC,DA,DR,DIADD,DLAYGO,DO

 +3        IF Y=-1

               WRITE !!,"Error in Creating Mail Group",!!

               QUIT 

 +4        SET BMCBULL=+Y

 +5        SET DIE="^XMB(3.8,"

           SET DA=BMCBULL

           SET DR="4////PUBLIC;3///A Bulletin is sent when a INHOUSE Type Referral is entered;7////N;5////"_DUZ

           DO ^DIE

           KILL DIE,DA,DR,DIU,DIY,DIW,DIV

 +6        IF $DATA(Y)

               WRITE !!,"Error in updating INHOUSE Mail Group",!!

 +7        QUIT 

 +8       ;

END       ;

 +1        WRITE !!,"Mail Groups Successfully Installed",!," - Now add appropriate Members to each of the following Mail Groups",!!

 +2        WRITE "BMC IHS ALERT",!

 +3        WRITE "BMC CHS ALERT",!

 +4        WRITE "BMC OTHER ALERT",!

 +5        WRITE "BMC INHOUSE ALERT",!

 +6        KILL BMCBULL

           QUIT