ATXPVT.m

ATXPVT ; IHS/OHPRD/TMJ -  CREATES A TEMPLATE LINKED TO V POV FILE FOR ALL ENTRIES ; 

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

 ;IN THE V POV FILE FOR A GIVEN TAXONOMY

 ;

 S U="^",ATXFIL=9000010.07 ;ATXFIL IS IN THE INPUT TEMPLATE ATXEARCH (FILE #)

 D DT^DICRW

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

 I '$D(ATXTP) D DATES

 D EOJ

 Q

 ;

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(^ATXAX(+Y,21,0)) W !,$C(7),"No ICD codes entered in this taxonomy!" G START

 S ATXX=+Y

 Q

 ;

SORTEMP ; ENTRY POINT - CREATES SORT TEMPLATE

 W ! S DIC="^DIBT(",DIC("DR")="[ATXEARCH]",DIC(0)="AEMQL",DLAYGO=.401,DIC("A")="Select SEARCH TEMPLATE: ",DIC("S")="I $P(^(0),U,5)=DUZ&($P(^(0),U,4)=ATXFIL)" D ^DIC K DIC I Y<0 S ATXTP="" Q

 S ATXTMP=+Y ;SAVE DFN OF TEMPLATE CHOSEN OR CREATED BY USER

 I $D(^DIBT(ATXTMP,2)) W !!,$C(7),"You cannot store results in a template used only for sort purposes." S Y="" Q

 I '$D(^DIBT(ATXTMP,1))&('$D(^DIBT(ATXTMP,"DIS"))) Q  ;NO RESULTS, NO FM SEARCH CODE

 I $D(^DIBT(ATXTMP,1)) W !!,$C(7),"Results already stored in this template.  Do you want to have",!,"the stored data deleted" S %=1 D YN^DICN

 I '$D(^DIBT(ATXTMP,1)) S %=1 ;IF A SEARCH TEMPLATE WITH NO RESULTS STORED

 I %=2 S Y="" Q

 I %=1 S DIE="^DIBT(",DA=ATXTMP,DR="[ATXDEL]" D ^DIE K DIE D TEST Q

 S Y=""

 Q

 ;

TEST ;SEE IF USER HATTED OUT OF [ATXDEL]

 I $D(ATXY) S Y="" K ATXY Q

 E  K ^DIBT(ATXTMP,1),^("DIS"),^("O") S Y=1

 Q

 ;

DATES ;ENTER RANGE OF VISIT DATES

 W !!,"Enter a range of visit dates from which to extract entries:"

ASKBD S %DT="AEX",%DT("A")="Enter beginning visit date: FIRST// " D ^%DT G:X=U A S ATXBDT=$S(X="":0,1:Y) I Y<0,X]"" G ASKBD

ASKED S %DT="AEX",%DT("A")="Enter ending visit date: LAST// " D ^%DT G:X=U A S ATXEDT=$S(X="":9999999,1:Y) I Y<0,X]"" G ASKED

 I ATXBDT>ATXEDT!(ATXEDT>DT&(ATXEDT'=9999999)) W !,"Beginning and ending dates must be prior to today, and beginning date",!,"must precede ending date.",! G ASKBD

 D ^ATXTSK

 I 'ATXTSK,'$D(ATXTP) D DFNS

A Q

 ;

ZTM ;ENTRY POINT FOR TASKMAN

 D DFNS

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

 D EOJ

 Q

 ;

DFNS ;GET LO AND HIGH DFNS FOR THIS TAXONOMY

 S ATXSS=0 F ATXL=0:0 S ATXSS=$O(^ATXAX(ATXX,21,ATXSS)) Q:ATXSS'=+ATXSS  S ATXLOV=$P(^(ATXSS,0),U)_" ",ATXHIV=$P(^(0),U,2)_" " D GETVAL

 S (ATXCNT,ATXDOLO)=0 F L=0:0 S ATXDOLO=$O(^DIBT(ATXTMP,1,ATXDOLO)) Q:ATXDOLO=""  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

 K ^TMP("ATXSEARCH",$J)

 D:$D(ATXPAT) EOJ

 Q

 ;

GETVAL ;GET RANGE OF DFNS

 K ^TMP("ATXSEARCH",$J)

 S ATXDFN=$O(^ICD9("BA",ATXLOV,"")),^TMP("ATXSEARCH",$J,ATXDFN)=""

 I ATXHIV=ATXLOV D LOOP Q

 F ATXL=0:0 S ATXLOV=$O(^ICD9("BA",ATXLOV)) Q:ATXLOV](ATXHIV)!(ATXLOV="")  S ATXDFN=$O(^ICD9("BA",ATXLOV,""))

 D LOOP

 Q

 ;

LOOP ;GET DFNS FROM V POV FILE FOR THIS ICD CODE DFN

 ;STORE IN APPROPRIATE TEMPLATE

 S ATXPV=0

 S ATXVIS=(ATXBDT-1)_.999999

 F ATXL=0:0 S ATXVIS=$O(^AUPNVSIT("B",ATXVIS)) Q:ATXVIS>(ATXEDT_.9999)!(ATXVIS="")  S ATXVDFN=$O(^(ATXVIS,"")),ATXPV=$O(^AUPNVPOV("AD",ATXVDFN,"")) I ATXPV,$D(^TMP("ATXSEARCH",$J,+^AUPNVPOV(ATXPV,0))) D @$S($D(ATXPAT):"PAT",1:"POV")

 Q

 ;

POV ;CREATES NODES FOR LINKAGE TO V POV FILE

 W:'ATXTSK "."

 S ^DIBT(ATXTMP,1,ATXPV)=""

 Q

 ;

PAT ;CREATES NODES FOR LINKAGE TO V POV FILE

 W:'ATXTSK "."

 S ATXPAT=$P(^AUPNVPOV(ATXPV,0),U,2) S:ATXPAT]"" ^DIBT(ATXTMP,1,ATXPAT)=""

 Q

 ;

EOJ ;

 K ATXFIL,ATXL,ATXTP,ATXSTP,ATXTMP,ATXX,ATXHI,ATXLOV,ATXLO,ATXPV,ATXDFN,ATXBDT,ATXEDT,ATXDTE,ATXCNT,ATXTSK,ATXDOLO,ATXSS,ATXVDFN

 K %,%DT

 Q

 ;

ATXPVT    ; IHS/OHPRD/TMJ -  CREATES A TEMPLATE LINKED TO V POV FILE FOR ALL ENTRIES ; 

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

 +2       ;IN THE V POV FILE FOR A GIVEN TAXONOMY

 +3       ;

 +4       ;ATXFIL IS IN THE INPUT TEMPLATE ATXEARCH (FILE #)

           SET U="^"

           SET ATXFIL=9000010.07

 +5        DO DT^DICRW

 +6        DO START

           IF '$DATA(ATXTP)

               SET Y=""

               FOR ATXL=0:0

                   IF Y]""

                       QUIT 

                   DO SORTEMP

 +7        IF '$DATA(ATXTP)

               DO DATES

 +8        DO EOJ

 +9        QUIT 

 +10      ;

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 '$ORDER(^ATXAX(+Y,21,0))

               WRITE !,$CHAR(7),"No ICD codes entered in this taxonomy!"

               GOTO START

 +5        SET ATXX=+Y

 +6        QUIT 

 +7       ;

SORTEMP   ; ENTRY POINT - CREATES SORT TEMPLATE

 +1        WRITE !

           SET DIC="^DIBT("

           SET DIC("DR")="[ATXEARCH]"

           SET DIC(0)="AEMQL"

           SET DLAYGO=.401

           SET DIC("A")="Select SEARCH TEMPLATE: "

           SET DIC("S")="I $P(^(0),U,5)=DUZ&($P(^(0),U,4)=ATXFIL)"

           DO ^DIC

           KILL DIC

           IF Y<0

               SET ATXTP=""

               QUIT 

 +2       ;SAVE DFN OF TEMPLATE CHOSEN OR CREATED BY USER

           SET ATXTMP=+Y

 +3        IF $DATA(^DIBT(ATXTMP,2))

               WRITE !!,$CHAR(7),"You cannot store results in a template used only for sort purposes."

               SET Y=""

               QUIT 

 +4       ;NO RESULTS, NO FM SEARCH CODE

           IF '$DATA(^DIBT(ATXTMP,1))&('$DATA(^DIBT(ATXTMP,"DIS")))

               QUIT 

 +5        IF $DATA(^DIBT(ATXTMP,1))

               WRITE !!,$CHAR(7),"Results already stored in this template.  Do you want to have",!,"the stored data deleted"

               SET %=1

               DO YN^DICN

 +6       ;IF A SEARCH TEMPLATE WITH NO RESULTS STORED

           IF '$DATA(^DIBT(ATXTMP,1))

               SET %=1

 +7        IF %=2

               SET Y=""

               QUIT 

 +8        IF %=1

               SET DIE="^DIBT("

               SET DA=ATXTMP

               SET DR="[ATXDEL]"

               DO ^DIE

               KILL DIE

               DO TEST

               QUIT 

 +9        SET Y=""

 +10       QUIT 

 +11      ;

TEST      ;SEE IF USER HATTED OUT OF [ATXDEL]

 +1        IF $DATA(ATXY)

               SET Y=""

               KILL ATXY

               QUIT 

 +2       IF '$TEST

               KILL ^DIBT(ATXTMP,1),^("DIS"),^("O")

               SET Y=1

 +3        QUIT 

 +4       ;

DATES     ;ENTER RANGE OF VISIT DATES

 +1        WRITE !!,"Enter a range of visit dates from which to extract entries:"

ASKBD      SET %DT="AEX"

           SET %DT("A")="Enter beginning visit date: FIRST// "

           DO ^%DT

           IF X=U

               GOTO A

           SET ATXBDT=$SELECT(X="":0,1:Y)

           IF Y<0

               IF X]""

                   GOTO ASKBD

ASKED      SET %DT="AEX"

           SET %DT("A")="Enter ending visit date: LAST// "

           DO ^%DT

           IF X=U

               GOTO A

           SET ATXEDT=$SELECT(X="":9999999,1:Y)

           IF Y<0

               IF X]""

                   GOTO ASKED

 +1        IF ATXBDT>ATXEDT!(ATXEDT>DT&(ATXEDT'=9999999))

               WRITE !,"Beginning and ending dates must be prior to today, and beginning date",!,"must precede ending date.",!

               GOTO ASKBD

 +2        DO ^ATXTSK

 +3        IF 'ATXTSK

               IF '$DATA(ATXTP)

                   DO DFNS

A          QUIT 

 +1       ;

ZTM       ;ENTRY POINT FOR TASKMAN

 +1        DO DFNS

 +2        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        DO EOJ

 +4        QUIT 

 +5       ;

DFNS      ;GET LO AND HIGH DFNS FOR THIS TAXONOMY

 +1        SET ATXSS=0

           FOR ATXL=0:0

               SET ATXSS=$ORDER(^ATXAX(ATXX,21,ATXSS))

               IF ATXSS'=+ATXSS

                   QUIT 

               SET ATXLOV=$PIECE(^(ATXSS,0),U)_" "

               SET ATXHIV=$PIECE(^(0),U,2)_" "

               DO GETVAL

 +2        SET (ATXCNT,ATXDOLO)=0

           FOR L=0:0

               SET ATXDOLO=$ORDER(^DIBT(ATXTMP,1,ATXDOLO))

               IF ATXDOLO=""

                   QUIT 

               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        KILL ^TMP("ATXSEARCH",$JOB)

 +6        IF $DATA(ATXPAT)

               DO EOJ

 +7        QUIT 

 +8       ;

GETVAL    ;GET RANGE OF DFNS

 +1        KILL ^TMP("ATXSEARCH",$JOB)

 +2        SET ATXDFN=$ORDER(^ICD9("BA",ATXLOV,""))

           SET ^TMP("ATXSEARCH",$JOB,ATXDFN)=""

 +3        IF ATXHIV=ATXLOV

               DO LOOP

               QUIT 

 +4        FOR ATXL=0:0

               SET ATXLOV=$ORDER(^ICD9("BA",ATXLOV))

               IF ATXLOV](ATXHIV)!(ATXLOV="")

                   QUIT 

               SET ATXDFN=$ORDER(^ICD9("BA",ATXLOV,""))

 +5        DO LOOP

 +6        QUIT 

 +7       ;

LOOP      ;GET DFNS FROM V POV FILE FOR THIS ICD CODE DFN

 +1       ;STORE IN APPROPRIATE TEMPLATE

 +2        SET ATXPV=0

 +3        SET ATXVIS=(ATXBDT-1)_.999999

 +4        FOR ATXL=0:0

               SET ATXVIS=$ORDER(^AUPNVSIT("B",ATXVIS))

               IF ATXVIS>(ATXEDT_.9999)!(ATXVIS="")

                   QUIT 

               SET ATXVDFN=$ORDER(^(ATXVIS,""))

               SET ATXPV=$ORDER(^AUPNVPOV("AD",ATXVDFN,""))

               IF ATXPV

                   IF $DATA(^TMP("ATXSEARCH",$JOB,+^AUPNVPOV(ATXPV,0)))

                       DO @$SELECT($DATA(ATXPAT):"PAT",1:"POV")

 +5        QUIT 

 +6       ;

POV       ;CREATES NODES FOR LINKAGE TO V POV FILE

 +1        IF 'ATXTSK

               WRITE "."

 +2        SET ^DIBT(ATXTMP,1,ATXPV)=""

 +3        QUIT 

 +4       ;

PAT       ;CREATES NODES FOR LINKAGE TO V POV FILE

 +1        IF 'ATXTSK

               WRITE "."

 +2        SET ATXPAT=$PIECE(^AUPNVPOV(ATXPV,0),U,2)

           IF ATXPAT]""

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

 +3        QUIT 

 +4       ;

EOJ       ;

 +1        KILL ATXFIL,ATXL,ATXTP,ATXSTP,ATXTMP,ATXX,ATXHI,ATXLOV,ATXLO,ATXPV,ATXDFN,ATXBDT,ATXEDT,ATXDTE,ATXCNT,ATXTSK,ATXDOLO,ATXSS,ATXVDFN

 +2        KILL %,%DT

 +3        QUIT 

 +4       ;