BMCPOST2 ; IHS/PHXAO/TMJ - ADD MAIL GROUP TO BULLENTIN ENTRY ;
;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
;
W !!,?5,"***I Will now add the appropriate Mail Group Entry to each Mail Bulletin***",!!
D ADDCHS,ADDIHS,ADDOTHER,ADDINHOU
W !!,?5,"**Mail Groups entries to Bulletin File are now Complete**",!!
D END
Q
;
ADDCHS ;ADD BMC CHS ALERT Mail Group
;
S BMCBULL="BMC CHS ALERT" D
. S BMCBIEN=$O(^XMB(3.6,"B",BMCBULL,0))
. I 'BMCBIEN W !,BMCBULL," bulletin not found.....I was unable to add BMC CHS ALERT mail group to this Bulletin." Q
. I $D(^XMB(3.6,BMCBIEN,2,"B","BMC CHS ALERT")) W !,"Mail Group Entry already Exists in Mail Group field of the Bulletin File",!! Q
. S DIC="^XMB(3.6,"_BMCBIEN_",2,"
. S DIC(0)="L"
. S DIC("P")=$P(^DD(3.6,4,0),U,2)
. S DA(1)=BMCBIEN
. S X=$O(^XMB(3.8,"B","BMC CHS ALERT",0))
. I 'X W !,"Can't find the BMC CHS ALERT Mail Group." Q
. K DD,DO
. D FILE^DICN K DIC
. I +Y<0 W !?5,"Multiple entry was unsuccessful: ",X K X Q
. W !?5,X_" Mail Group added to the "_BMCBULL_" Bulletin."
. K X,Y,DA
. Q
K BMCBIEN,BMCBULL
W !!
Q
;
;
ADDIHS ;
;
S BMCBULL="BMC IHS ALERT" D
. S BMCBIEN=$O(^XMB(3.6,"B",BMCBULL,0))
. I 'BMCBIEN W !,BMCBULL," bulletin not found.....I was unable to add BMC IHS ALERT mail group to this Bulletin." Q
. I $D(^XMB(3.6,BMCBIEN,2,"B","BMC IHS ALERT")) W !,"Mail Group Entry already Exists in Mail Group field of the Bulletin File",!! Q
. S DIC="^XMB(3.6,"_BMCBIEN_",2,"
. S DIC(0)="L"
. S DIC("P")=$P(^DD(3.6,4,0),U,2)
. S DA(1)=BMCBIEN
. S X=$O(^XMB(3.8,"B","BMC IHS ALERT",0))
. I 'X W !,"Can't find BMC IHS ALERT Mail Group." Q
. K DD,DO
. D FILE^DICN K DIC
. I +Y<0 W !?5,"Multiple entry was unsuccessful: ",X K X Q
. W !?5,X_" Mail Group added to the "_BMCBULL_" Bulletin."
. K X,Y,DA
. Q
K BMCBIEN,BMCBULL
W !!
Q
;
ADDOTHER ;
;
S BMCBULL="BMC OTHER ALERT" D
. S BMCBIEN=$O(^XMB(3.6,"B",BMCBULL,0))
. I 'BMCBIEN W !,BMCBULL," bulletin not found.....I was unable to add BMC OTHER ALERT mail group to this Bulletin." Q
. I $D(^XMB(3.6,BMCBIEN,2,"B","BMC OTHER ALERT")) W !,"Mail Group Entry already Exists in Mail Group field of the Bulletin File",!! Q
. S DIC="^XMB(3.6,"_BMCBIEN_",2,"
. S DIC(0)="L"
. S DIC("P")=$P(^DD(3.6,4,0),U,2)
. S DA(1)=BMCBIEN
. S X=$O(^XMB(3.8,"B","BMC OTHER ALERT",0))
. I 'X W !,"Can't find the BMC OTHER ALERT Mail Group." Q
. K DD,DO
. D FILE^DICN K DIC
. I +Y<0 W !?5,"Multiple entry was unsuccessful: ",X K X Q
. W !?5,X_" Mail Group added to the "_BMCBULL_" Bulletin."
. K X,Y,DA
. Q
K BMCBIEN,BMCBULL
W !!
Q
;
ADDINHOU ;
;
S BMCBULL="BMC INHOUSE ALERT" D
. S BMCBIEN=$O(^XMB(3.6,"B",BMCBULL,0))
. I 'BMCBIEN W !,BMCBULL," bulletin not found.....I was unable to add BMC INHOUSE ALERT mail group to this Bulletin." Q
. I $D(^XMB(3.6,BMCBIEN,2,"B","BMC INHOUSE ALERT")) W !,"Mail Group Entry already Exists in Mail Group field of the Bulletin File",!! Q
. S DIC="^XMB(3.6,"_BMCBIEN_",2,"
. S DIC(0)="L"
. S DIC("P")=$P(^DD(3.6,4,0),U,2)
. S DA(1)=BMCBIEN
. S X=$O(^XMB(3.8,"B","BMC INHOUSE ALERT",0))
. I 'X W !,"Can't find the BMC INHOUSE ALERT Mail Group." Q
. K DD,DO
. D FILE^DICN K DIC
. I +Y<0 W !?5,"Multiple entry was unsuccessful: ",X K X Q
. W !?5,X_" Mail Group added to the "_BMCBULL_" Bulletin."
. K X,Y,DA
. Q
K BMCBIEN,BMCBULL
W !!
Q
END ;
K BMCBIEN,BMCBULL
BMCPOST2 ; IHS/PHXAO/TMJ - ADD MAIL GROUP TO BULLENTIN ENTRY ;
+1 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
+2 ;
+3 WRITE !!,?5,"***I Will now add the appropriate Mail Group Entry to each Mail Bulletin***",!!
+4 DO ADDCHS
DO ADDIHS
DO ADDOTHER
DO ADDINHOU
+5 WRITE !!,?5,"**Mail Groups entries to Bulletin File are now Complete**",!!
+6 DO END
+7 QUIT
+8 ;
ADDCHS ;ADD BMC CHS ALERT Mail Group
+1 ;
+2 SET BMCBULL="BMC CHS ALERT"
Begin DoDot:1
+3 SET BMCBIEN=$ORDER(^XMB(3.6,"B",BMCBULL,0))
+4 IF 'BMCBIEN
WRITE !,BMCBULL," bulletin not found.....I was unable to add BMC CHS ALERT mail group to this Bulletin."
QUIT
+5 IF $DATA(^XMB(3.6,BMCBIEN,2,"B","BMC CHS ALERT"))
WRITE !,"Mail Group Entry already Exists in Mail Group field of the Bulletin File",!!
QUIT
+6 SET DIC="^XMB(3.6,"_BMCBIEN_",2,"
+7 SET DIC(0)="L"
+8 SET DIC("P")=$PIECE(^DD(3.6,4,0),U,2)
+9 SET DA(1)=BMCBIEN
+10 SET X=$ORDER(^XMB(3.8,"B","BMC CHS ALERT",0))
+11 IF 'X
WRITE !,"Can't find the BMC CHS ALERT Mail Group."
QUIT
+12 KILL DD,DO
+13 DO FILE^DICN
KILL DIC
+14 IF +Y<0
WRITE !?5,"Multiple entry was unsuccessful: ",X
KILL X
QUIT
+15 WRITE !?5,X_" Mail Group added to the "_BMCBULL_" Bulletin."
+16 KILL X,Y,DA
+17 QUIT
End DoDot:1
+18 KILL BMCBIEN,BMCBULL
+19 WRITE !!
+20 QUIT
+21 ;
+22 ;
ADDIHS ;
+1 ;
+2 SET BMCBULL="BMC IHS ALERT"
Begin DoDot:1
+3 SET BMCBIEN=$ORDER(^XMB(3.6,"B",BMCBULL,0))
+4 IF 'BMCBIEN
WRITE !,BMCBULL," bulletin not found.....I was unable to add BMC IHS ALERT mail group to this Bulletin."
QUIT
+5 IF $DATA(^XMB(3.6,BMCBIEN,2,"B","BMC IHS ALERT"))
WRITE !,"Mail Group Entry already Exists in Mail Group field of the Bulletin File",!!
QUIT
+6 SET DIC="^XMB(3.6,"_BMCBIEN_",2,"
+7 SET DIC(0)="L"
+8 SET DIC("P")=$PIECE(^DD(3.6,4,0),U,2)
+9 SET DA(1)=BMCBIEN
+10 SET X=$ORDER(^XMB(3.8,"B","BMC IHS ALERT",0))
+11 IF 'X
WRITE !,"Can't find BMC IHS ALERT Mail Group."
QUIT
+12 KILL DD,DO
+13 DO FILE^DICN
KILL DIC
+14 IF +Y<0
WRITE !?5,"Multiple entry was unsuccessful: ",X
KILL X
QUIT
+15 WRITE !?5,X_" Mail Group added to the "_BMCBULL_" Bulletin."
+16 KILL X,Y,DA
+17 QUIT
End DoDot:1
+18 KILL BMCBIEN,BMCBULL
+19 WRITE !!
+20 QUIT
+21 ;
ADDOTHER ;
+1 ;
+2 SET BMCBULL="BMC OTHER ALERT"
Begin DoDot:1
+3 SET BMCBIEN=$ORDER(^XMB(3.6,"B",BMCBULL,0))
+4 IF 'BMCBIEN
WRITE !,BMCBULL," bulletin not found.....I was unable to add BMC OTHER ALERT mail group to this Bulletin."
QUIT
+5 IF $DATA(^XMB(3.6,BMCBIEN,2,"B","BMC OTHER ALERT"))
WRITE !,"Mail Group Entry already Exists in Mail Group field of the Bulletin File",!!
QUIT
+6 SET DIC="^XMB(3.6,"_BMCBIEN_",2,"
+7 SET DIC(0)="L"
+8 SET DIC("P")=$PIECE(^DD(3.6,4,0),U,2)
+9 SET DA(1)=BMCBIEN
+10 SET X=$ORDER(^XMB(3.8,"B","BMC OTHER ALERT",0))
+11 IF 'X
WRITE !,"Can't find the BMC OTHER ALERT Mail Group."
QUIT
+12 KILL DD,DO
+13 DO FILE^DICN
KILL DIC
+14 IF +Y<0
WRITE !?5,"Multiple entry was unsuccessful: ",X
KILL X
QUIT
+15 WRITE !?5,X_" Mail Group added to the "_BMCBULL_" Bulletin."
+16 KILL X,Y,DA
+17 QUIT
End DoDot:1
+18 KILL BMCBIEN,BMCBULL
+19 WRITE !!
+20 QUIT
+21 ;
ADDINHOU ;
+1 ;
+2 SET BMCBULL="BMC INHOUSE ALERT"
Begin DoDot:1
+3 SET BMCBIEN=$ORDER(^XMB(3.6,"B",BMCBULL,0))
+4 IF 'BMCBIEN
WRITE !,BMCBULL," bulletin not found.....I was unable to add BMC INHOUSE ALERT mail group to this Bulletin."
QUIT
+5 IF $DATA(^XMB(3.6,BMCBIEN,2,"B","BMC INHOUSE ALERT"))
WRITE !,"Mail Group Entry already Exists in Mail Group field of the Bulletin File",!!
QUIT
+6 SET DIC="^XMB(3.6,"_BMCBIEN_",2,"
+7 SET DIC(0)="L"
+8 SET DIC("P")=$PIECE(^DD(3.6,4,0),U,2)
+9 SET DA(1)=BMCBIEN
+10 SET X=$ORDER(^XMB(3.8,"B","BMC INHOUSE ALERT",0))
+11 IF 'X
WRITE !,"Can't find the BMC INHOUSE ALERT Mail Group."
QUIT
+12 KILL DD,DO
+13 DO FILE^DICN
KILL DIC
+14 IF +Y<0
WRITE !?5,"Multiple entry was unsuccessful: ",X
KILL X
QUIT
+15 WRITE !?5,X_" Mail Group added to the "_BMCBULL_" Bulletin."
+16 KILL X,Y,DA
+17 QUIT
End DoDot:1
+18 KILL BMCBIEN,BMCBULL
+19 WRITE !!
+20 QUIT
END ;
+1 KILL BMCBIEN,BMCBULL
