Routine: ATXRCH

ATXRCH ; IHS/OHPRD/TMJ -  SEARCH TEMPLATE PT FILE W/ PAT TAX NAMES ;

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

 S U="^",ATXFIL=9000001,ATXTSK=0

 D DT^DICRW

 D START I '$D(ATXTP) S Y="" F ATXL=0:0 Q:Y]""  D SORTEMP^ATXPVT

 I '$D(ATXTP) D @$S($D(ATXPAT):"DATES^ATXPVT",1:"^ATXTSK") I '$D(ATXPAT),'ATXTSK,'$D(ATXTP) D SEARCH

 D EOJ

START ;

 S DIC="^ATXAX(",DIC(0)="AEMQ",DIC("DR")="" D ^DIC K DIC

 I Y<1 S ATXTP=1 Q

 I $D(^TMP("ATXTAX",+Y)) W !,$C(7),"Taxonomy currently",^(+Y)," Try later.",! G START

 I '$O(^ATXPAT(+Y,11,0)) S ATXPAT="" ;IF NO PTS IN PT TAX FILE, GOES TO DATES^ATXPVT TO FIND PT DFNS

 S ATXX=+Y

 D:'$D(ATXPAT) USER

USER ;INFORMS USER AS TO WHERE ENTRIES COMING FROM

 D DATE S ATXONE="W ""Create a search template with patient entries from the patient list"",!,""in the Pt Taxonomy file.  This list of patients starts with the visit"",!,""date "",ATXDATE,""."""

 S ATXTWO="W ""Create a search template of patients seen during a range of visit dates."",!,""These patients will have had a purpose of visit that falls within this taxonomy."""

ASK W !!,"Select, by number, one of the following: ",!!,1," " X ATXONE W !,2," " X ATXTWO R !,"Your choice (1 or 2): ",ATXPCK:DTIME

 I "^"[ATXPCK S ATXTP="" G A

 I ATXPCK=2 S ATXPAT="" G A

 I $E(ATXPCK)="?" D HELP G ASK

 I ATXPCK'=1 G ASK

A Q

DATE ;GET DATE FOR LINE USER+2

 S Y=$P(^ATXAX(ATXX,0),U,6) X ^DD("DD")

 S ATXDATE=Y

HELP ;

 W:$D(IOF) @IOF

 W !!,"Either select option one and a template will be automatically created or",!,"select option two and you will be able to enter a range of visit dates during",!,"which time patients who fall within the selected taxonomy were seen."

ZTM ;ENTRY POINT FOR TASKMAN

 D SEARCH

 I $D(ZTQUEUED) S ZTREQ="@"

 D EOJ

SEARCH ;CREATES RESULT NODES AND SPECIFICATION NODES IN ^DIBT(ATXTMP,

 S (ATXCNT,ATXDFN)=0

 W:'ATXTSK !! F ATXL=0:0 S ATXDFN=$O(^ATXPAT(ATXX,11,ATXDFN)) Q:ATXDFN'=+ATXDFN  S ^DIBT(ATXTMP,1,ATXDFN)="" W:'ATXTSK "." S ATXCNT=ATXCNT+1

 W !!,"There ",$S(ATXCNT'=1:"were ",1:"was "),ATXCNT,$S(ATXCNT'=1:" entries",1:" entry")," in the ",$P(^DIBT(ATXTMP,0),U)," template."

 S ^DIBT(ATXTMP,1,0)=ATXCNT

EOJ ;

 K ATXFIL,ATXL,ATXTP,ATXTMP,ATXX,ATXO,ATXHI,ATXLOV,ATXLO,ATXPV,ATXY,ATXL,ATXTP,ATXX,ATXDFN,ATXTMP,ATXPAT,ATXONE,ATXTWO,ATXPCK,ATXCNT,ATXTSK,ATXDATE

ATXRCH    ; IHS/OHPRD/TMJ -  SEARCH TEMPLATE PT FILE W/ PAT TAX NAMES ;

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

 +2       ;

 +3        SET U="^"

           SET ATXFIL=9000001

           SET ATXTSK=0

 +4        DO DT^DICRW

 +5        DO START

           IF '$DATA(ATXTP)

               SET Y=""

               FOR ATXL=0:0

                   IF Y]""

                       QUIT

                   DO SORTEMP^ATXPVT

 +6        IF '$DATA(ATXTP)

               DO @$SELECT($DATA(ATXPAT):"DATES^ATXPVT",1:"^ATXTSK")

               IF '$DATA(ATXPAT)

                   IF 'ATXTSK

                       IF '$DATA(ATXTP)

                           DO SEARCH

 +7        DO EOJ

 +8        QUIT

 +9       ;

START     ;

 +1        SET DIC="^ATXAX("

           SET DIC(0)="AEMQ"

           SET DIC("DR")=""

           DO ^DIC

           KILL DIC

 +2        IF Y<1

               SET ATXTP=1

               QUIT

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

               WRITE !,$CHAR(7),"Taxonomy currently",^(+Y)," Try later.",!

               GOTO START

 +4       ;IF NO PTS IN PT TAX FILE, GOES TO DATES^ATXPVT TO FIND PT DFNS

           IF '$ORDER(^ATXPAT(+Y,11,0))

               SET ATXPAT=""

 +5        SET ATXX=+Y

 +6        IF '$DATA(ATXPAT)

               DO USER

 +7        QUIT

 +8       ;

USER      ;INFORMS USER AS TO WHERE ENTRIES COMING FROM

 +1        DO DATE

           SET ATXONE="W ""Create a search template with patient entries from the patient list"",!,""in the Pt Taxonomy file.  This list of patients starts with the visit"",!,""date "",ATXDATE,""."""

 +2        SET ATXTWO="W ""Create a search template of patients seen during a range of visit dates."",!,""These patients will have had a purpose of visit that falls within this taxonomy."""

ASK        WRITE !!,"Select, by number, one of the following: ",!!,1," "

           XECUTE ATXONE

           WRITE !,2," "

           XECUTE ATXTWO

           READ !,"Your choice (1 or 2): ",ATXPCK:DTIME

 +1        IF "^"[ATXPCK

               SET ATXTP=""

               GOTO A

 +2        IF ATXPCK=2

               SET ATXPAT=""

               GOTO A

 +3        IF $EXTRACT(ATXPCK)="?"

               DO HELP

               GOTO ASK

 +4        IF ATXPCK'=1

               GOTO ASK

A          QUIT

 +1       ;

DATE      ;GET DATE FOR LINE USER+2

 +1        SET Y=$PIECE(^ATXAX(ATXX,0),U,6)

           XECUTE ^DD("DD")

 +2        SET ATXDATE=Y

 +3        QUIT

 +4       ;

HELP      ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !!,"Either select option one and a template will be automatically created or",!,"select option two and you will be able to enter a range of visit dates during",!,"which time patients who fall within the selected taxonomy were seen."

 +3        QUIT

 +4       ;

ZTM       ;ENTRY POINT FOR TASKMAN

 +1        DO SEARCH

 +2        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        DO EOJ

 +4        QUIT

 +5       ;

SEARCH    ;CREATES RESULT NODES AND SPECIFICATION NODES IN ^DIBT(ATXTMP,

 +1        SET (ATXCNT,ATXDFN)=0

 +2        IF 'ATXTSK

               WRITE !!

           FOR ATXL=0:0

               SET ATXDFN=$ORDER(^ATXPAT(ATXX,11,ATXDFN))

               IF ATXDFN'=+ATXDFN

                   QUIT

               SET ^DIBT(ATXTMP,1,ATXDFN)=""

               IF 'ATXTSK

                   WRITE "."

               SET ATXCNT=ATXCNT+1

 +3        WRITE !!,"There ",$SELECT(ATXCNT'=1:"were ",1:"was "),ATXCNT,$SELECT(ATXCNT'=1:" entries",1:" entry")," in the ",$PIECE(^DIBT(ATXTMP,0),U)," template."

 +4        SET ^DIBT(ATXTMP,1,0)=ATXCNT

 +5        QUIT

 +6       ;

EOJ       ;

 +1        KILL ATXFIL,ATXL,ATXTP,ATXTMP,ATXX,ATXO,ATXHI,ATXLOV,ATXLO,ATXPV,ATXY,ATXL,ATXTP,ATXX,ATXDFN,ATXTMP,ATXPAT,ATXONE,ATXTWO,ATXPCK,ATXCNT,ATXTSK,ATXDATE

 +2        QUIT

 +3       ;

ATXRCH.m