ATXCODE2 ; IHS/OHPRD/TMJ - CODES IF MODIFYING AND ENTERS CODES INTO FILE ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
I '$D(ATXX) D ASK I $D(ATXSTP)!'$D(ATXX) Q
D @$S($D(ATX("ENTER")):"ENTER",1:"EDIT")
D EOJ
Q
;
ASK ;ASK FOR TAXONOMY IF NOT COMING THROUGH TAXONOMY SYSTEM
W !!,"Would you like to save these codes in a Taxonomy for future use" S %=2 D YN^DICN
I %=2!(%=-1) Q
I %=0 W !!,"You may store these ICD codes in the TAXONOMY file if you desire. You will be",!,"able to use these in future database searches." G ASK
I %=1 D S ATXFLG="",DIC("S")="I $P(^(0),U,5)=DUZ,$P(^(0),U,8)",DIC="^ATXAX(",DIC(0)="AEMQL",DIC("DR")=".05////"_DUZ_";.09////"_ATXTIME_";.13////1;.14////BA;.15////80;.16////1",DLAYGO=9002226 D ^DIC K DIC,ATXTIME
. S %H=$H D YX^%DTC S ATXTIME=X_%
I Y=-1 S ATXSTP=1 G X
I $O(^ATXAX(+Y,21,0)) W !!,$C(7),"You have selected a taxonomy with codes already entered. Do you want to delete",!,"the codes in this taxonomy and enter this new range of codes" S %=2 D YN^DICN D I %'=1 G ASK
. I %=1 S ATX("EDIT")="",ATXX=+Y W !!,$P(^ATXAX(ATXX,0),U)," TAXONOMY:"
. I %=0 W !!,"You may add codes to an existing taxonomy by selecting a taxonomy when asked to ""ENTER DX:"""
I '$O(^ATXAX(+Y,21,0)) S ATXX=+Y,ATX("ENTER")=""
I $D(ATX("ENTER"))!$D(ATX("EDIT")) S DIE="^ATXAX(",DR=".02;1101;.08////1",DA=ATXX D ^DIE K DIE,DR
X Q
;
ENTER ;
I '$D(ZTQUEUED),$D(ATX("NOT TAX")) W !!,"Entering codes into the ",$P(^ATXAX(ATXX,0),U)," taxonomy"
E I '$D(ZTQUEUED),$D(ATX("NOT TAX")) W !,"One moment please ..."
S ATX=0 F S ATX=$O(ATXTABLE(ATX)) Q:ATX="" S ATX("X")=$E(ATX,1,($L(ATX)-1)) D CALLDIE I $D(Y) S ATXSTP=1 Q
I '$D(ZTQUEUED),$D(ATX("NOT TAX")) W !!,"Done!"
Q
;
CALLDIE ;
S ATXHI=$E(ATXTABLE(ATX),1,($L(ATXTABLE(ATX))-1)),DIE="^ATXAX(",DR="2101///"_ATX("X"),DA=ATXX,DR(2,9002226.02101)=".02////"_ATXHI D ^DIE I $D(Y)
E I '$D(ZTQUEUED),$D(ATX("NOT TAX")) W "."
I $D(Y),'$D(ZTQUEUED),$D(ATX("NOT TAX")) W !!,"ERROR ENCOUNTERED - REENTER RANGES",!
K DIE,DR,DA
Q
;
EDIT ;DELETE CODES IN TAXONOMY FILE, THEN ENTER NEW RANGES
S ATX=0 F S ATX=$O(^ATXAX(ATXX,21,ATX)) Q:ATX'=+ATX S DA(1)=ATXX,DA=ATX,DIK="^ATXAX("_DA(1)_",21," D ^DIK K DIK,DA
D ENTER
Q
;
EOJ ;
K ATXHI
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
ATXCODE2 ; IHS/OHPRD/TMJ - CODES IF MODIFYING AND ENTERS CODES INTO FILE ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 IF '$DATA(ATXX)
DO ASK
IF $DATA(ATXSTP)!'$DATA(ATXX)
QUIT
+4 DO @$SELECT($DATA(ATX("ENTER")):"ENTER",1:"EDIT")
+5 DO EOJ
+6 QUIT
+7 ;
ASK ;ASK FOR TAXONOMY IF NOT COMING THROUGH TAXONOMY SYSTEM
+1 WRITE !!,"Would you like to save these codes in a Taxonomy for future use"
SET %=2
DO YN^DICN
+2 IF %=2!(%=-1)
QUIT
+3 IF %=0
WRITE !!,"You may store these ICD codes in the TAXONOMY file if you desire. You will be",!,"able to use these in future database searches."
GOTO ASK
+4 IF %=1
Begin DoDot:1
+5 SET %H=$HOROLOG
DO YX^%DTC
SET ATXTIME=X_%
End DoDot:1
SET ATXFLG=""
SET DIC("S")="I $P(^(0),U,5)=DUZ,$P(^(0),U,8)"
SET DIC="^ATXAX("
SET DIC(0)="AEMQL"
SET DIC("DR")=".05////"_DUZ_";.09////"_ATXTIME_";.13////1;.14////BA;.15////80;.16////1"
SET DLAYGO=9002226
DO ^DIC
KILL DIC,ATXTIME
+6 IF Y=-1
SET ATXSTP=1
GOTO X
+7 IF $ORDER(^ATXAX(+Y,21,0))
WRITE !!,$CHAR(7),"You have selected a taxonomy with codes already entered. Do you want to delete",!,"the codes in this taxonomy and enter this new range of codes"
SET %=2
DO YN^DICN
Begin DoDot:1
+8 IF %=1
SET ATX("EDIT")=""
SET ATXX=+Y
WRITE !!,$PIECE(^ATXAX(ATXX,0),U)," TAXONOMY:"
+9 IF %=0
WRITE !!,"You may add codes to an existing taxonomy by selecting a taxonomy when asked to ""ENTER DX:"""
End DoDot:1
IF %'=1
GOTO ASK
+10 IF '$ORDER(^ATXAX(+Y,21,0))
SET ATXX=+Y
SET ATX("ENTER")=""
+11 IF $DATA(ATX("ENTER"))!$DATA(ATX("EDIT"))
SET DIE="^ATXAX("
SET DR=".02;1101;.08////1"
SET DA=ATXX
DO ^DIE
KILL DIE,DR
X QUIT
+1 ;
ENTER ;
+1 IF '$DATA(ZTQUEUED)
IF $DATA(ATX("NOT TAX"))
WRITE !!,"Entering codes into the ",$PIECE(^ATXAX(ATXX,0),U)," taxonomy"
+2 IF '$TEST
IF '$DATA(ZTQUEUED)
IF $DATA(ATX("NOT TAX"))
WRITE !,"One moment please ..."
+3 SET ATX=0
FOR
SET ATX=$ORDER(ATXTABLE(ATX))
IF ATX=""
QUIT
SET ATX("X")=$EXTRACT(ATX,1,($LENGTH(ATX)-1))
DO CALLDIE
IF $DATA(Y)
SET ATXSTP=1
QUIT
+4 IF '$DATA(ZTQUEUED)
IF $DATA(ATX("NOT TAX"))
WRITE !!,"Done!"
+5 QUIT
+6 ;
CALLDIE ;
+1 SET ATXHI=$EXTRACT(ATXTABLE(ATX),1,($LENGTH(ATXTABLE(ATX))-1))
SET DIE="^ATXAX("
SET DR="2101///"_ATX("X")
SET DA=ATXX
SET DR(2,9002226.02101)=".02////"_ATXHI
DO ^DIE
IF $DATA(Y)
+2 IF '$TEST
IF '$DATA(ZTQUEUED)
IF $DATA(ATX("NOT TAX"))
WRITE "."
+3 IF $DATA(Y)
IF '$DATA(ZTQUEUED)
IF $DATA(ATX("NOT TAX"))
WRITE !!,"ERROR ENCOUNTERED - REENTER RANGES",!
+4 KILL DIE,DR,DA
+5 QUIT
+6 ;
EDIT ;DELETE CODES IN TAXONOMY FILE, THEN ENTER NEW RANGES
+1 SET ATX=0
FOR
SET ATX=$ORDER(^ATXAX(ATXX,21,ATX))
IF ATX'=+ATX
QUIT
SET DA(1)=ATXX
SET DA=ATX
SET DIK="^ATXAX("_DA(1)_",21,"
DO ^DIK
KILL DIK,DA
+2 DO ENTER
+3 QUIT
+4 ;
EOJ ;
+1 KILL ATXHI
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 QUIT
+4 ;
