- ATXTAXF ; IHS/CMI/LAB - DISPLAY IND LISTS ;
- ;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48
- ;; ;
- ICD9ADD ;EP
- S ATXFLG=""
- I ATXFILE=80 S ATXGBL="^ICD9("
- I ATXFILE=80.1 S ATXGBL="^ICD0("
- S ATXX=ATXTAXI
- D BUILD,^ATXCODE
- D EDIT
- K ATXFLG,ATXX,ATXL,ATX,ATXTBLE,ATXSYS
- Q
- ;
- BUILD ;BUILD ATXTBLE FOR ROUTINE ATXCODE
- NEW X,Y,A,B
- S X="" F S X=$O(^ATXAX(ATXX,21,"B",X)) Q:X="" D
- .S Y=0 F S Y=$O(^ATXAX(ATXX,21,"B",X,Y)) Q:Y="" D
- ..S A=$P(^ATXAX(ATXX,21,Y,0),U,1),B=$P(^ATXAX(ATXX,21,Y,0),U,2),C=$P(^ATXAX(ATXX,21,Y,0),U,3)
- ..S ATXTBLE(A)=B_U_C
- Q
- ENTER ;
- S ATX=0 F S ATX=$O(ATXTBLE(ATX)) Q:ATX="" S ATX("X")=$$STRIP^XLFSTR(ATX," ") D CALLDIE I $D(Y) S ATXSTP=1 Q
- I $P(^ATXAX(ATXX,0),U,8),$P(^(0),U,15)=80 D DFNS^ATXAX ;IF CREATED BY TAXONOMY SYSTEM - EDIT 41 MULTIPLE IN FILE 80
- W !!,"Done!"
- Q
- ;
- CALLDIE ;
- S ATXHI=$$STRIP^XLFSTR($P(ATXTBLE(ATX),U,1)," ")
- S ATXSYS=$P(ATXTBLE(ATX),U,2)
- S DIE="^ATXAX(",DR="2101///"_ATX("X")_" ",DA=ATXX,DR(2,9002226.02101)=".02////"_ATXHI_" "_";.03////"_ATXSYS 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
- ;IF CREATED BY TAXONOMY SYSTEM, DELETE ALL FROM ICD9 41 MULTIPLE
- W !,"hold on..."
- I $P(^ATXAX(ATXX,0),U,8),$P(^(0),U,15)=80 D DFNS^ATXDEL ;delete out of icd9 41 multiple
- 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
- ;
- EOJ1 ;
- K ATXHI
- I $D(ZTQUEUED) S ZTREQ="@"
- Q
- ;
- ATXTAXF ; IHS/CMI/LAB - DISPLAY IND LISTS ;
- +1 ;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48
- +2 ;; ;
- ICD9ADD ;EP
- +1 SET ATXFLG=""
- +2 IF ATXFILE=80
- SET ATXGBL="^ICD9("
- +3 IF ATXFILE=80.1
- SET ATXGBL="^ICD0("
- +4 SET ATXX=ATXTAXI
- +5 DO BUILD
- DO ^ATXCODE
- +6 DO EDIT
- +7 KILL ATXFLG,ATXX,ATXL,ATX,ATXTBLE,ATXSYS
- +8 QUIT
- +9 ;
- BUILD ;BUILD ATXTBLE FOR ROUTINE ATXCODE
- +1 NEW X,Y,A,B
- +2 SET X=""
- FOR
- SET X=$ORDER(^ATXAX(ATXX,21,"B",X))
- IF X=""
- QUIT
- Begin DoDot:1
- +3 SET Y=0
- FOR
- SET Y=$ORDER(^ATXAX(ATXX,21,"B",X,Y))
- IF Y=""
- QUIT
- Begin DoDot:2
- +4 SET A=$PIECE(^ATXAX(ATXX,21,Y,0),U,1)
- SET B=$PIECE(^ATXAX(ATXX,21,Y,0),U,2)
- SET C=$PIECE(^ATXAX(ATXX,21,Y,0),U,3)
- +5 SET ATXTBLE(A)=B_U_C
- End DoDot:2
- End DoDot:1
- +6 QUIT
- ENTER ;
- +1 SET ATX=0
- FOR
- SET ATX=$ORDER(ATXTBLE(ATX))
- IF ATX=""
- QUIT
- SET ATX("X")=$$STRIP^XLFSTR(ATX," ")
- DO CALLDIE
- IF $DATA(Y)
- SET ATXSTP=1
- QUIT
- +2 ;IF CREATED BY TAXONOMY SYSTEM - EDIT 41 MULTIPLE IN FILE 80
- IF $PIECE(^ATXAX(ATXX,0),U,8)
- IF $PIECE(^(0),U,15)=80
- DO DFNS^ATXAX
- +3 WRITE !!,"Done!"
- +4 QUIT
- +5 ;
- CALLDIE ;
- +1 SET ATXHI=$$STRIP^XLFSTR($PIECE(ATXTBLE(ATX),U,1)," ")
- +2 SET ATXSYS=$PIECE(ATXTBLE(ATX),U,2)
- +3 SET DIE="^ATXAX("
- SET DR="2101///"_ATX("X")_" "
- SET DA=ATXX
- SET DR(2,9002226.02101)=".02////"_ATXHI_" "_";.03////"_ATXSYS
- DO ^DIE
- IF $DATA(Y)
- +4 IF '$TEST
- IF '$DATA(ZTQUEUED)
- IF $DATA(ATX("NOT TAX"))
- WRITE "."
- +5 IF $DATA(Y)
- IF '$DATA(ZTQUEUED)
- IF $DATA(ATX("NOT TAX"))
- WRITE !!,"ERROR ENCOUNTERED - REENTER RANGES",!
- +6 KILL DIE,DR,DA
- +7 QUIT
- +8 ;
- EDIT ;DELETE CODES IN TAXONOMY FILE, THEN ENTER NEW RANGES
- +1 ;IF CREATED BY TAXONOMY SYSTEM, DELETE ALL FROM ICD9 41 MULTIPLE
- +2 WRITE !,"hold on..."
- +3 ;delete out of icd9 41 multiple
- IF $PIECE(^ATXAX(ATXX,0),U,8)
- IF $PIECE(^(0),U,15)=80
- DO DFNS^ATXDEL
- +4 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
- +5 DO ENTER
- +6 QUIT
- +7 ;
- EOJ1 ;
- +1 KILL ATXHI
- +2 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +3 QUIT
- +4 ;
