ATXBULL2 ; IHS/OHPRD/TMJ - AND DELETE BULLETINS FOR A TAXONOMY ; 30 Oct 2012 7:22 AM
;;5.1;TAXONOMY;**11,17**;FEB 04, 1997;Build 29
;
ENTER ; ENTRY POINT - Taxonomy updated with bulletin to be triggered for a taxonomy; new bulletin for each taxonomy will be created
;S ATXFLG=""
;S DIC="^ATXAX(",DIC(0)="AEMQ",DIC("S")="I I $P(^(0),U,5)=DUZ,I $P(^(0),U,8)" D ^DIC K DR,DA,DIC K DIC I Y<1 G X1
S ATXDFN=ATXX
I $P(^ATXAX(ATXDFN,0),U,7) S ATXEXIST=1 W !,"If you want to change the mail group designated for this taxonomy's bulletin,",!,"delete the bulletin for this taxonomy and then recreate the bulletin and enter",!,"a new mail group."
E D CREATE I '$D(ATXBULL) W !,$C(7),"Bulletin could not be created!" G X1
W !!
I '$D(ATXDEL) D
. I '$D(ATXEXIST) S DIE="^ATXAX(",DA=ATXDFN,DR=".07////"_ATXBULL D ^DIE K DIE,DA,ATXBULL
. S DA=ATXDFN,DIE="^ATXAX(",DR="[ATX BULLETIN SETUP" D ^DIE K DIE,DA,ATXBULL
. I '$D(ATXEXIST) W !!,"Okay, a bulletin has been created for this taxonomy."
X1 K ATXEXIST,ATXBULL,ATXDFN,ATXFLG,ATXDEL Q
;
DELETE ; ENTRY POINT - Delete a bulletin from a taxonomy
W !,"Use this option to stop sending a bulletin for a taxonomy."
W !,"To resume sending a bulletin after it has been deleted, recreate it"
W !,"using the Enter Bulletin for a Taxonomy option."
W !
S ATXFLG=""
S DIC="^ATXAX(",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,8)" D ^DIC K DIC I Y<1 G X2
I '$P(^ATXAX(+Y,0),U,7) W !,"A bulletin does not exist for this taxonomy." G X2
S ATXDFN=+Y,ATXDFN("BULL")=$P(^ATXAX(+Y,0),U,7)
S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to no longer have a bulletin issued for this taxonomy" D ^DIR K DIR
I Y=1 S DA=ATXDFN,DR=".03///@;.07///@;.11///@",DIE="^ATXAX(" D ^DIE K DA,DIE W !,"Okay, the bulletin has been deleted for this taxonomy."
X2 K ATXDFN,ATXBULL,ATXFLG Q
;
CREATE ; Create copy of ATX BULLETIN for this taxonomy
S X="ATX "_$P(^ATXAX(ATXDFN,0),U),DIC="^XMB(3.6,",DIC("DR")="2///PATIENT SEEN FOR AN ENTRY WITHIN A TAXONOMY",DIC(0)="L",DIADD=1,DLAYGO=3.6 S:$L(X)>30 X=$E(X,1,30) D ^DIC K DIC,DR,DA,DIADD,DLAYGO I Y<0 G X3
S ATXBULL=+Y
S ATXCOPY=$O(^XMB(3.6,"B","ATX BULLETIN",""))
S %X="^XMB(3.6,ATXCOPY,1,",%Y="^XMB(3.6,ATXBULL,1," D %XY^%RCR
S $P(^XMB(3.6,ATXBULL,1,0),U,5)=DT
S DIC="^XMB(3.6,ATXBULL,2,",DA(1)=ATXBULL,DIC(0)="AEMQL",DIC("P")=$P(^DD(3.6,4,0),U,2) D ^DIC K DIC,DA,DR I Y>0 S ATXGRP=+^XMB(3.6,ATXBULL,2,+Y,0) D
A . S DIC="^XMB(3.8,ATXGRP,1,",DA(1)=ATXGRP,DIC(0)="AEMQL",DIC("P")=$P(^DD(3.8,2,0),U,2) D ^DIC K DIC,DA,DR G:"^"'[X A
I '$D(ATXGRP) W !,"Mail group not indicated, bulletin being removed for this taxonomy." S DA=ATXBULL,DIK="^XMB(3.6," D ^DIK K DA,DIK S ATXDEL=""
X3 K ATXCOPY,ATXGRP,ATXSUB Q
;
HFD ;EP - call from executable help
D EN^DDIOL("If you only want a bulletin sent the very first time the")
D EN^DDIOL("patient has had this diagnosis enter Yes below. It would")
D EN^DDIOL("be appropriate to answer yes if you only want a bulletin for a")
D EN^DDIOL("new case of a diagnosis.")
Q
ATXBULL2 ; IHS/OHPRD/TMJ - AND DELETE BULLETINS FOR A TAXONOMY ; 30 Oct 2012 7:22 AM
+1 ;;5.1;TAXONOMY;**11,17**;FEB 04, 1997;Build 29
+2 ;
ENTER ; ENTRY POINT - Taxonomy updated with bulletin to be triggered for a taxonomy; new bulletin for each taxonomy will be created
+1 ;S ATXFLG=""
+2 ;S DIC="^ATXAX(",DIC(0)="AEMQ",DIC("S")="I I $P(^(0),U,5)=DUZ,I $P(^(0),U,8)" D ^DIC K DR,DA,DIC K DIC I Y<1 G X1
+3 SET ATXDFN=ATXX
+4 IF $PIECE(^ATXAX(ATXDFN,0),U,7)
SET ATXEXIST=1
WRITE !,"If you want to change the mail group designated for this taxonomy's bulletin,",!,"delete the bulletin for this taxonomy and then recreate the bulletin and enter",!,"a new mail group."
+5 IF '$TEST
DO CREATE
IF '$DATA(ATXBULL)
WRITE !,$CHAR(7),"Bulletin could not be created!"
GOTO X1
+6 WRITE !!
+7 IF '$DATA(ATXDEL)
Begin DoDot:1
+8 IF '$DATA(ATXEXIST)
SET DIE="^ATXAX("
SET DA=ATXDFN
SET DR=".07////"_ATXBULL
DO ^DIE
KILL DIE,DA,ATXBULL
+9 SET DA=ATXDFN
SET DIE="^ATXAX("
SET DR="[ATX BULLETIN SETUP"
DO ^DIE
KILL DIE,DA,ATXBULL
+10 IF '$DATA(ATXEXIST)
WRITE !!,"Okay, a bulletin has been created for this taxonomy."
End DoDot:1
X1 KILL ATXEXIST,ATXBULL,ATXDFN,ATXFLG,ATXDEL
QUIT
+1 ;
DELETE ; ENTRY POINT - Delete a bulletin from a taxonomy
+1 WRITE !,"Use this option to stop sending a bulletin for a taxonomy."
+2 WRITE !,"To resume sending a bulletin after it has been deleted, recreate it"
+3 WRITE !,"using the Enter Bulletin for a Taxonomy option."
+4 WRITE !
+5 SET ATXFLG=""
+6 SET DIC="^ATXAX("
SET DIC(0)="AEMQ"
SET DIC("S")="I $P(^(0),U,8)"
DO ^DIC
KILL DIC
IF Y<1
GOTO X2
+7 IF '$PIECE(^ATXAX(+Y,0),U,7)
WRITE !,"A bulletin does not exist for this taxonomy."
GOTO X2
+8 SET ATXDFN=+Y
SET ATXDFN("BULL")=$PIECE(^ATXAX(+Y,0),U,7)
+9 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Are you sure you want to no longer have a bulletin issued for this taxonomy"
DO ^DIR
KILL DIR
+10 IF Y=1
SET DA=ATXDFN
SET DR=".03///@;.07///@;.11///@"
SET DIE="^ATXAX("
DO ^DIE
KILL DA,DIE
WRITE !,"Okay, the bulletin has been deleted for this taxonomy."
X2 KILL ATXDFN,ATXBULL,ATXFLG
QUIT
+1 ;
CREATE ; Create copy of ATX BULLETIN for this taxonomy
+1 SET X="ATX "_$PIECE(^ATXAX(ATXDFN,0),U)
SET DIC="^XMB(3.6,"
SET DIC("DR")="2///PATIENT SEEN FOR AN ENTRY WITHIN A TAXONOMY"
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=3.6
IF $LENGTH(X)>30
SET X=$EXTRACT(X,1,30)
DO ^DIC
KILL DIC,DR,DA,DIADD,DLAYGO
IF Y<0
GOTO X3
+2 SET ATXBULL=+Y
+3 SET ATXCOPY=$ORDER(^XMB(3.6,"B","ATX BULLETIN",""))
+4 SET %X="^XMB(3.6,ATXCOPY,1,"
SET %Y="^XMB(3.6,ATXBULL,1,"
DO %XY^%RCR
+5 SET $PIECE(^XMB(3.6,ATXBULL,1,0),U,5)=DT
+6 SET DIC="^XMB(3.6,ATXBULL,2,"
SET DA(1)=ATXBULL
SET DIC(0)="AEMQL"
SET DIC("P")=$PIECE(^DD(3.6,4,0),U,2)
DO ^DIC
KILL DIC,DA,DR
IF Y>0
SET ATXGRP=+^XMB(3.6,ATXBULL,2,+Y,0)
Begin DoDot:1
A SET DIC="^XMB(3.8,ATXGRP,1,"
SET DA(1)=ATXGRP
SET DIC(0)="AEMQL"
SET DIC("P")=$PIECE(^DD(3.8,2,0),U,2)
DO ^DIC
KILL DIC,DA,DR
IF "^"'[X
GOTO A
End DoDot:1
+1 IF '$DATA(ATXGRP)
WRITE !,"Mail group not indicated, bulletin being removed for this taxonomy."
SET DA=ATXBULL
SET DIK="^XMB(3.6,"
DO ^DIK
KILL DA,DIK
SET ATXDEL=""
X3 KILL ATXCOPY,ATXGRP,ATXSUB
QUIT
+1 ;
HFD ;EP - call from executable help
+1 DO EN^DDIOL("If you only want a bulletin sent the very first time the")
+2 DO EN^DDIOL("patient has had this diagnosis enter Yes below. It would")
+3 DO EN^DDIOL("be appropriate to answer yes if you only want a bulletin for a")
+4 DO EN^DDIOL("new case of a diagnosis.")
+5 QUIT
