- 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 ;
