- AQAOCOD2 ; IHS/ORDC/LJF - RETRIEVES CODES IF MOD & ENTERS CODES INTO FILE ;
- ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- ;IHS/ORDC/LJF; copy of rtn ^ATXCODE2 ;;4.2;Taxonomy;;MAR 19, 1991
- ; changes: changed namespacing from ATX to AQAO
- ; added check if using procedures, taxonomies for dx only
- ; added incremental locks
- ;
- ;
- I AQAOICD=0 Q ;IHS/ORDC/LJF cannot add taxonomy for procedures
- I '$D(AQAOX) D ASK I $D(AQAOSTP)!'$D(AQAOX) Q
- D @$S($D(AQAO("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 D G ASK
- .W !!,"You may store these ICD codes in the TAXONOMY file if you"
- .W " desire. You will be",!,"able to use these in future database"
- .W " searches."
- I %=1 D
- .S %H=$H D YX^%DTC S AQAOTIME=X_%
- .S ATXFLG="",DIC("S")="I $P(^(0),U,5)=DUZ,$P(^(0),U,8)"
- .S DIC="^ATXAX(",DIC(0)="AEMQL"
- .S DIC("DR")=".05////"_DUZ_";.09////"_AQAOTIME_";.13////1;.14////BA;.15////80;.16////1"
- .S DLAYGO=9002226 L +(^ATXAX(0)):1 I '$T W !!,"TAXONOMY FILE LOCKED; CANNOT ADD. TRY AGAIN!",! Q ;IHS/ORDC/LJF added lock
- .D ^DIC L -(^ATXAX(0))
- .K DIC,AQAOTIME,ATXFLG,DLAYGO
- I Y=-1 S AQAOSTP=1 G X
- I $O(^ATXAX(+Y,21,0)) W !!,*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 AQAO("EDIT")="",AQAOX=+Y W !!,$P(^ATXAX(AQAOX,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 AQAOX=+Y,AQAO("ENTER")=""
- I $D(AQAO("ENTER"))!$D(AQAO("EDIT")) L +^ATXAX(AQAOX):1 Q:'$T S DIE="^ATXAX(",DR=".02;1101;.08////1",DA=AQAOX D ^DIE K DIE,DR L -^ATXAX(AQAOX) ;IHS/ORDC/LJF added lock
- X Q
- ;
- ENTER ;
- I '$D(ZTQUEUED),$D(AQAO("NOT TAX")) W !!,"Entering codes into the ",$P(^ATXAX(AQAOX,0),U)," taxonomy"
- E I '$D(ZTQUEUED),$D(AQAO("NOT TAX")) W !,"One moment please ..."
- S AQAO=0 F S AQAO=$O(AQAOTBL(AQAO)) Q:AQAO="" S AQAO("X")=$E(AQAO,1,($L(AQAO)-1)) D CALLDIE I $D(Y) S AQAOSTP=1 Q
- I '$D(ZTQUEUED),$D(AQAO("NOT TAX")) W !!,"Done!"
- Q
- ;
- CALLDIE ;
- L +^ATXAX(AQAOX):1 I '$T W !!,"CANNOT EDIT; TAXONOMY LOCKED. TRY AGAIN.",! Q ;IHS/ORDC/LJF added line
- S AQAOHI=$E(AQAOTBL(AQAO),1,($L(AQAOTBL(AQAO))-1)),DIE="^ATXAX(",DR="2101///"_AQAO("X"),DA=AQAOX,DR(2,9002226.02101)=".02////"_AQAOHI D ^DIE L -^ATXAX(AQAOX) I $D(Y)
- E I '$D(ZTQUEUED),$D(AQAO("NOT TAX")) W "."
- I $D(Y),'$D(ZTQUEUED),$D(AQAO("NOT TAX")) W !!,"ERROR ENCOUNTERED - REENTER RANGES",!
- K DIE,DR,DA
- Q
- ;
- EDIT ;DELETE CODES IN TAXONOMY FILE, THEN ENTER NEW RANGES
- S AQAO=0 F S AQAO=$O(^ATXAX(AQAOX,21,AQAO)) Q:AQAO'=+AQAO S DA(1)=AQAOX,DA=AQAO,DIK="^ATXAX("_DA(1)_",21," D ^DIK K DIK,DA
- D ENTER
- Q
- ;
- EOJ ;
- K AQAOHI
- I $D(ZTQUEUED) S ZTREQ="@"
- Q
- ;
- AQAOCOD2 ; IHS/ORDC/LJF - RETRIEVES CODES IF MOD & ENTERS CODES INTO FILE ;
- +1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- +2 ;IHS/ORDC/LJF; copy of rtn ^ATXCODE2 ;;4.2;Taxonomy;;MAR 19, 1991
- +3 ; changes: changed namespacing from ATX to AQAO
- +4 ; added check if using procedures, taxonomies for dx only
- +5 ; added incremental locks
- +6 ;
- +7 ;
- +8 ;IHS/ORDC/LJF cannot add taxonomy for procedures
- IF AQAOICD=0
- QUIT
- +9 IF '$DATA(AQAOX)
- DO ASK
- IF $DATA(AQAOSTP)!'$DATA(AQAOX)
- QUIT
- +10 DO @$SELECT($DATA(AQAO("ENTER")):"ENTER",1:"EDIT")
- +11 DO EOJ
- +12 QUIT
- +13 ;
- 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"
- +2 SET %=2
- DO YN^DICN
- IF %=2!(%=-1)
- QUIT
- +3 IF %=0
- Begin DoDot:1
- +4 WRITE !!,"You may store these ICD codes in the TAXONOMY file if you"
- +5 WRITE " desire. You will be",!,"able to use these in future database"
- +6 WRITE " searches."
- End DoDot:1
- GOTO ASK
- +7 IF %=1
- Begin DoDot:1
- +8 SET %H=$HOROLOG
- DO YX^%DTC
- SET AQAOTIME=X_%
- +9 SET ATXFLG=""
- SET DIC("S")="I $P(^(0),U,5)=DUZ,$P(^(0),U,8)"
- +10 SET DIC="^ATXAX("
- SET DIC(0)="AEMQL"
- +11 SET DIC("DR")=".05////"_DUZ_";.09////"_AQAOTIME_";.13////1;.14////BA;.15////80;.16////1"
- +12 ;IHS/ORDC/LJF added lock
- SET DLAYGO=9002226
- LOCK +(^ATXAX(0)):1
- IF '$TEST
- WRITE !!,"TAXONOMY FILE LOCKED; CANNOT ADD. TRY AGAIN!",!
- QUIT
- +13 DO ^DIC
- LOCK -(^ATXAX(0))
- +14 KILL DIC,AQAOTIME,ATXFLG,DLAYGO
- End DoDot:1
- +15 IF Y=-1
- SET AQAOSTP=1
- GOTO X
- +16 IF $ORDER(^ATXAX(+Y,21,0))
- WRITE !!,*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
- +17 IF %=1
- SET AQAO("EDIT")=""
- SET AQAOX=+Y
- WRITE !!,$PIECE(^ATXAX(AQAOX,0),U)," TAXONOMY:"
- +18 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
- +19 IF '$ORDER(^ATXAX(+Y,21,0))
- SET AQAOX=+Y
- SET AQAO("ENTER")=""
- +20 ;IHS/ORDC/LJF added lock
- IF $DATA(AQAO("ENTER"))!$DATA(AQAO("EDIT"))
- LOCK +^ATXAX(AQAOX):1
- IF '$TEST
- QUIT
- SET DIE="^ATXAX("
- SET DR=".02;1101;.08////1"
- SET DA=AQAOX
- DO ^DIE
- KILL DIE,DR
- LOCK -^ATXAX(AQAOX)
- X QUIT
- +1 ;
- ENTER ;
- +1 IF '$DATA(ZTQUEUED)
- IF $DATA(AQAO("NOT TAX"))
- WRITE !!,"Entering codes into the ",$PIECE(^ATXAX(AQAOX,0),U)," taxonomy"
- +2 IF '$TEST
- IF '$DATA(ZTQUEUED)
- IF $DATA(AQAO("NOT TAX"))
- WRITE !,"One moment please ..."
- +3 SET AQAO=0
- FOR
- SET AQAO=$ORDER(AQAOTBL(AQAO))
- IF AQAO=""
- QUIT
- SET AQAO("X")=$EXTRACT(AQAO,1,($LENGTH(AQAO)-1))
- DO CALLDIE
- IF $DATA(Y)
- SET AQAOSTP=1
- QUIT
- +4 IF '$DATA(ZTQUEUED)
- IF $DATA(AQAO("NOT TAX"))
- WRITE !!,"Done!"
- +5 QUIT
- +6 ;
- CALLDIE ;
- +1 ;IHS/ORDC/LJF added line
- LOCK +^ATXAX(AQAOX):1
- IF '$TEST
- WRITE !!,"CANNOT EDIT; TAXONOMY LOCKED. TRY AGAIN.",!
- QUIT
- +2 SET AQAOHI=$EXTRACT(AQAOTBL(AQAO),1,($LENGTH(AQAOTBL(AQAO))-1))
- SET DIE="^ATXAX("
- SET DR="2101///"_AQAO("X")
- SET DA=AQAOX
- SET DR(2,9002226.02101)=".02////"_AQAOHI
- DO ^DIE
- LOCK -^ATXAX(AQAOX)
- IF $DATA(Y)
- +3 IF '$TEST
- IF '$DATA(ZTQUEUED)
- IF $DATA(AQAO("NOT TAX"))
- WRITE "."
- +4 IF $DATA(Y)
- IF '$DATA(ZTQUEUED)
- IF $DATA(AQAO("NOT TAX"))
- WRITE !!,"ERROR ENCOUNTERED - REENTER RANGES",!
- +5 KILL DIE,DR,DA
- +6 QUIT
- +7 ;
- EDIT ;DELETE CODES IN TAXONOMY FILE, THEN ENTER NEW RANGES
- +1 SET AQAO=0
- FOR
- SET AQAO=$ORDER(^ATXAX(AQAOX,21,AQAO))
- IF AQAO'=+AQAO
- QUIT
- SET DA(1)=AQAOX
- SET DA=AQAO
- SET DIK="^ATXAX("_DA(1)_",21,"
- DO ^DIK
- KILL DIK,DA
- +2 DO ENTER
- +3 QUIT
- +4 ;
- EOJ ;
- +1 KILL AQAOHI
- +2 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +3 QUIT
- +4 ;
