- 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
