ATXEMP ; IHS/OHPRD/TMJ - ICD CODES FOR A GIVEN TAXONOMY BEFORE MODIFICATION ;
;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48
;
D INIT
F ATXL=0:0 D START W ! Q:ATXSTP
K ATXL,ATXSTP
D EOJ
Q
;
INIT ;
S U="^",ATXFLG=""
Q
;
START ;
D ASK Q:ATXSTP
D TSKMN
D EOJ
Q
;
ASK ;
S ATXSTP=0
S DIC="^ATXAX(",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,5)=DUZ,$P(^(0),U,8)" D ^DIC K DIC
I Y<1 S ATXSTP=1 Q
I $D(^TMP($J,"ATXTAX",+Y)) W !,$C(7),"Taxonomy currently",^(+Y)," Try later.",! G ASK
I '$O(^ATXAX(+Y,21,0)) W !,$C(7),"This option for modifying existing ICD codes in taxonomies only!",!,"If you want to enter ICD codes for a taxonomy where none existed",!,"before, use the create taxonomy option.",! G ASK
S ATXX=+Y,^TMP($J,"ATXTAX",+Y)=" being modified."
K ^TMP($J,"ATXEMP",ATXX)
D DFNS
S DIE="^ATXAX(",DR=".01;.02;1101",DA=ATXX D ^DIE K DIE,DR
I $D(Y) S ATXSTP=1 K ^TMP($J,"ATXTAX",ATXX),^TMP($J,"ATXEMP",ATXX) Q
D BUILD,^ATXCODE
I ATXSTP=1 Q
Q
;
DFNS ;GET LO AND HIGH DFNS FOR THIS TAXONOMY
S ATXCNT=0
S ATXSS=0 F ATXL=0:0 S ATXSS=$O(^ATXAX(ATXX,21,ATXSS)) Q:ATXSS'=+ATXSS S ATXLOV=$P(^(ATXSS,0),U) S:ATXLOV'[" " ATXLOV=ATXLOV_" " D
.S ATXHIV=$P(^ATXAX(ATXX,21,ATXSS,0),U,2) S:ATXHIV'[" " ATXHIV=ATXHIV_" " S ATXCNT=ATXCNT+1,ATXLW(ATXCNT)=ATXLOV,ATXHIH(ATXCNT)=ATXHIV D GETVAL
Q
;
GETVAL ;GET RANGE OF DFNS
S ^TMP($J,"ATXEMP",ATXX,$O(^ICD9("BA",ATXLOV,"")))=""
Q:ATXLOV=ATXHIV
F ATXL=0:0 S ATXLOV=$O(^ICD9("BA",ATXLOV)) Q:ATXLOV](ATXHIV)!(ATXLOV="") S ATXDFN=$O(^ICD9("BA",ATXLOV,"")),^TMP($J,"ATXEMP",ATXX,ATXDFN)=""
Q
;
BUILD ;BUILD ATXTABLE FOR ROUTINE ATXCODE
S ATX("CODE")=0 F S ATX("CODE")=$O(^ATXAX(ATXX,21,"AA",ATX("CODE"))) Q:ATX("CODE")="" S ATXTABLE(ATX("CODE"))=$O(^(ATX("CODE"),""))
Q
;
TSKMN ;
I $O(^ATXPAT(ATXX,11,0)) W !!,$C(7),"Taxonomy will be modified (if changes were made) and patient list in PT TAXONOMY",!,"file will be updated in background by taskman!"
E W !!,$C(7),"Taxonomy will now be modified (if changes were made) in background by taskman!"
K ZTSAVE F %="ATXX" S ZTSAVE(%)=""
S ZTRTN="ZTM^ATXMOD",ZTDESC="MODIFY ICD9 TAXONOMY FIELD",ZTIO="",ZTDTH=DT D ^%ZTLOAD K ZTSK
Q
;
EOJ ;
K ATXLOV,ATXHIV,ATXLO,ATXHI,ATXDFN,ATXFLG,ATXP,ATXIOF,ATXCHK,ATXHIH,ATXLW,ATXI,ATXDLC,ATXX,ATXCNT,ATXDEL,ATXFLG,ATXSTOP,ATXSS
Q
;
ATXEMP ; IHS/OHPRD/TMJ - ICD CODES FOR A GIVEN TAXONOMY BEFORE MODIFICATION ;
+1 ;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48
+2 ;
+3 DO INIT
+4 FOR ATXL=0:0
DO START
WRITE !
IF ATXSTP
QUIT
+5 KILL ATXL,ATXSTP
+6 DO EOJ
+7 QUIT
+8 ;
INIT ;
+1 SET U="^"
SET ATXFLG=""
+2 QUIT
+3 ;
START ;
+1 DO ASK
IF ATXSTP
QUIT
+2 DO TSKMN
+3 DO EOJ
+4 QUIT
+5 ;
ASK ;
+1 SET ATXSTP=0
+2 SET DIC="^ATXAX("
SET DIC(0)="AEMQ"
SET DIC("S")="I $P(^(0),U,5)=DUZ,$P(^(0),U,8)"
DO ^DIC
KILL DIC
+3 IF Y<1
SET ATXSTP=1
QUIT
+4 IF $DATA(^TMP($JOB,"ATXTAX",+Y))
WRITE !,$CHAR(7),"Taxonomy currently",^(+Y)," Try later.",!
GOTO ASK
+5 IF '$ORDER(^ATXAX(+Y,21,0))
WRITE !,$CHAR(7),"This option for modifying existing ICD codes in taxonomies only!",!,"If you want to enter ICD codes for a taxonomy where none existed",!,"before, use the create taxonomy option.",!
GOTO ASK
+6 SET ATXX=+Y
SET ^TMP($JOB,"ATXTAX",+Y)=" being modified."
+7 KILL ^TMP($JOB,"ATXEMP",ATXX)
+8 DO DFNS
+9 SET DIE="^ATXAX("
SET DR=".01;.02;1101"
SET DA=ATXX
DO ^DIE
KILL DIE,DR
+10 IF $DATA(Y)
SET ATXSTP=1
KILL ^TMP($JOB,"ATXTAX",ATXX),^TMP($JOB,"ATXEMP",ATXX)
QUIT
+11 DO BUILD
DO ^ATXCODE
+12 IF ATXSTP=1
QUIT
+13 QUIT
+14 ;
DFNS ;GET LO AND HIGH DFNS FOR THIS TAXONOMY
+1 SET ATXCNT=0
+2 SET ATXSS=0
FOR ATXL=0:0
SET ATXSS=$ORDER(^ATXAX(ATXX,21,ATXSS))
IF ATXSS'=+ATXSS
QUIT
SET ATXLOV=$PIECE(^(ATXSS,0),U)
IF ATXLOV'[" "
SET ATXLOV=ATXLOV_" "
Begin DoDot:1
+3 SET ATXHIV=$PIECE(^ATXAX(ATXX,21,ATXSS,0),U,2)
IF ATXHIV'[" "
SET ATXHIV=ATXHIV_" "
SET ATXCNT=ATXCNT+1
SET ATXLW(ATXCNT)=ATXLOV
SET ATXHIH(ATXCNT)=ATXHIV
DO GETVAL
End DoDot:1
+4 QUIT
+5 ;
GETVAL ;GET RANGE OF DFNS
+1 SET ^TMP($JOB,"ATXEMP",ATXX,$ORDER(^ICD9("BA",ATXLOV,"")))=""
+2 IF ATXLOV=ATXHIV
QUIT
+3 FOR ATXL=0:0
SET ATXLOV=$ORDER(^ICD9("BA",ATXLOV))
IF ATXLOV](ATXHIV)!(ATXLOV="")
QUIT
SET ATXDFN=$ORDER(^ICD9("BA",ATXLOV,""))
SET ^TMP($JOB,"ATXEMP",ATXX,ATXDFN)=""
+4 QUIT
+5 ;
BUILD ;BUILD ATXTABLE FOR ROUTINE ATXCODE
+1 SET ATX("CODE")=0
FOR
SET ATX("CODE")=$ORDER(^ATXAX(ATXX,21,"AA",ATX("CODE")))
IF ATX("CODE")=""
QUIT
SET ATXTABLE(ATX("CODE"))=$ORDER(^(ATX("CODE"),""))
+2 QUIT
+3 ;
TSKMN ;
+1 IF $ORDER(^ATXPAT(ATXX,11,0))
WRITE !!,$CHAR(7),"Taxonomy will be modified (if changes were made) and patient list in PT TAXONOMY",!,"file will be updated in background by taskman!"
+2 IF '$TEST
WRITE !!,$CHAR(7),"Taxonomy will now be modified (if changes were made) in background by taskman!"
+3 KILL ZTSAVE
FOR %="ATXX"
SET ZTSAVE(%)=""
+4 SET ZTRTN="ZTM^ATXMOD"
SET ZTDESC="MODIFY ICD9 TAXONOMY FIELD"
SET ZTIO=""
SET ZTDTH=DT
DO ^%ZTLOAD
KILL ZTSK
+5 QUIT
+6 ;
EOJ ;
+1 KILL ATXLOV,ATXHIV,ATXLO,ATXHI,ATXDFN,ATXFLG,ATXP,ATXIOF,ATXCHK,ATXHIH,ATXLW,ATXI,ATXDLC,ATXX,ATXCNT,ATXDEL,ATXFLG,ATXSTOP,ATXSS
+2 QUIT
+3 ;
