ATXTDL.m

ATXTDL ; IHS/OHPRD/TMJ -  DELETES PATIENT LIST AND TAXONOMY ENTRY IN PT TAXONOMY FLE ; 

 ;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48

 ; ACC 1/24/94 added set and kill of ATXDEL, which were missing

 ;

 S U="^"

 ;SINCE A DELETE NODE FOR THE TAXONOMY FILE CHECKS $D(ATXDEL)

 S ATXDEL="" ;ACC 1/24/94

 F ATXL=0:0 D START Q:ATXSTP

 D EOJ

 Q

 ;

START ;

 D ASK Q:ATXSTP

 Q

 ;

ASK ;

 S ATXSTP=0

 S DIC="^ATXPAT(",DIC(0)="AEMQ",DIC("DR")="",DIC("S")="I $P(^(0),U,3)=DUZ&($P(^ATXAX(Y,0),U,4)="""")" D ^DIC K DIC

 I Y<1 S ATXSTP=1 Q

 I $D(^TMP("ATXTAX",+Y)) W !,$C(7),"This taxonomy now",^(+Y)," Try later.",! G ASK

 W !,$C(7),"Are you sure you want to delete the patient list for this taxonomy" S %=1 D YN^DICN

 I %=1 S ATXX=+Y,ATXQT="" D CALLDIK

 I %=2 Q

 I %=0 G ASK

 I %=-1 S ATXSTP=1 Q

 Q

 ;

CALLDIK ;DELETES TAXONOMY FROM PT TAXONOMY FILE, DELETES TAX START DATE FOR PT LIST

 ;TO ALLOW PATIENTS TO BE RENTERED AGAIN

 S DIK="^ATXPAT(",DA=ATXX D ^DIK K DIK,DA

 S DIE="^ATXAX(",DA=ATXX,DR=".06///@" D ^DIE K DIE,DR,DA

 W !,"Done!",!

 Q

 ;

EOJ ;

 K ATXL,ATXSTP,ATXX,ATXQT

 K ATXDEL ;ACC 1/24/94

 Q

 ;

ATXTDL    ; IHS/OHPRD/TMJ -  DELETES PATIENT LIST AND TAXONOMY ENTRY IN PT TAXONOMY FLE ; 

 +1       ;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48

 +2       ; ACC 1/24/94 added set and kill of ATXDEL, which were missing

 +3       ;

 +4        SET U="^"

 +5       ;SINCE A DELETE NODE FOR THE TAXONOMY FILE CHECKS $D(ATXDEL)

 +6       ;ACC 1/24/94

           SET ATXDEL=""

 +7        FOR ATXL=0:0

               DO START

               IF ATXSTP

                   QUIT 

 +8        DO EOJ

 +9        QUIT 

 +10      ;

START     ;

 +1        DO ASK

           IF ATXSTP

               QUIT 

 +2        QUIT 

 +3       ;

ASK       ;

 +1        SET ATXSTP=0

 +2        SET DIC="^ATXPAT("

           SET DIC(0)="AEMQ"

           SET DIC("DR")=""

           SET DIC("S")="I $P(^(0),U,3)=DUZ&($P(^ATXAX(Y,0),U,4)="""")"

           DO ^DIC

           KILL DIC

 +3        IF Y<1

               SET ATXSTP=1

               QUIT 

 +4        IF $DATA(^TMP("ATXTAX",+Y))

               WRITE !,$CHAR(7),"This taxonomy now",^(+Y)," Try later.",!

               GOTO ASK

 +5        WRITE !,$CHAR(7),"Are you sure you want to delete the patient list for this taxonomy"

           SET %=1

           DO YN^DICN

 +6        IF %=1

               SET ATXX=+Y

               SET ATXQT=""

               DO CALLDIK

 +7        IF %=2

               QUIT 

 +8        IF %=0

               GOTO ASK

 +9        IF %=-1

               SET ATXSTP=1

               QUIT 

 +10       QUIT 

 +11      ;

CALLDIK   ;DELETES TAXONOMY FROM PT TAXONOMY FILE, DELETES TAX START DATE FOR PT LIST

 +1       ;TO ALLOW PATIENTS TO BE RENTERED AGAIN

 +2        SET DIK="^ATXPAT("

           SET DA=ATXX

           DO ^DIK

           KILL DIK,DA

 +3        SET DIE="^ATXAX("

           SET DA=ATXX

           SET DR=".06///@"

           DO ^DIE

           KILL DIE,DR,DA

 +4        WRITE !,"Done!",!

 +5        QUIT 

 +6       ;

EOJ       ;

 +1        KILL ATXL,ATXSTP,ATXX,ATXQT

 +2       ;ACC 1/24/94

           KILL ATXDEL

 +3        QUIT 

 +4       ;