- 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
