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 ;
