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