IBDFLST ;ALM/MAF - Maintenance Utility Invalid Codes List ;05/17/95
;;3.0;AUTOMATED INFO COLLECTION SYS;**9,38,51,63**;APR 24, 1997;Build 80
;
;
;
START ; -- Ask what invalid code you want to display CPT/ ICD9/ Visit
N IBDFDIS
D FULL^VALM1
S DIR("B")="CPT"
;
S DIR(0)="SA^C:CPT;I:ICD9;D:ICD10;V:VISIT",DIR("A")="Display invalid codes for [C]PT, [I]CD9, IC[D]10, [V]ISIT: " D ^DIR
K DIR I $D(DIRUT)!(Y<0) G QUIT
;W !!,"Display invalid codes for CPT// " D ZSET1^IBDFLST1 S X="" R X:DTIME G QUIT:X="^"!('$T) I X=""!("Cc"[X) S X="1"
S X=$S("Ii"[X:2,"Dd"[X:3,"Vv"[X:4,1:1) ;
;I X="?" D ZSET1^IBDFLST1,HELP1^IBDFLST1 G START
S IBDFTYP=$E(X) ; D IN^DGHELP W ! I %=-1 D ZSET1^IBDFLST1,HELP1^IBDFLST1 G START
S IBDFDIS=$S(IBDFTYP=1:"CPT",IBDFTYP=2:"ICD9",IBDFTYP=3:"ICD10",IBDFTYP=4:"VISIT",1:"QUIT")
D WAIT^DICD
D EN^VALM("IBDF UTIL COMPLETE LIST TEMP")
Q
;
;
HDR ; -- header code
S VALMHDR(1)="This screen displays the most current invalid codes for the "_IBDFDIS_" file."
Q
;
;
SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
; S := string
; V := destination
; X := @ col X
; L := # of chars
;
Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
;
;
INIT ; -- Set up list for display
N IBDFCODE,IBDFDESC,IBDFIFN,IBDFCAT,IBDFNODE
S (IBDCNT,VALMCNT,IBDCNT1)=0
D @(IBDFDIS)
Q
;
; -- Gets CPT listing of invalid codes
CPT D FULL^VALM1 F IBDFIFN=0:0 S IBDFIFN=$O(^ICPT(IBDFIFN)) Q:'IBDFIFN D
.;; --change to api cpt ; dhh
.;; --note: 7th piece is status 0-inactive 1-active
. S IBDFNODE=$$CPT^ICPTCOD(IBDFIFN),IBDFNODE=$G(IBDFNODE)
. I $P(IBDFNODE,"^",7)=0 D
.. S IBDFCODE=$P(IBDFNODE,"^",2),IBDFDESC=$P(IBDFNODE,"^",3)
.. S IBDFCAT=$S($P(IBDFNODE,"^",4)]"":$P(^DIC(81.1,$P(IBDFNODE,"^",4),0),"^",1),1:"UNKNOWN") D ALPHA
D LOOP
Q
;
; -- Gets ICD9 listing of invalid codes
; -- Use api for ICD9
ICD9 ;;F IBDFIFN=0:0 S IBDFIFN=$O(^ICD9(IBDFIFN)) Q:'IBDFIFN S IBDFNODE=$G(^ICD9(IBDFIFN,0)) I $P(IBDFNODE,"^",9)]"" D
;
;Use ICD API to check the status for CSV. No date is passed so the
;default day is DT (today). $P10 = status 0-inactive 1-active
D ICD9LST
;F IBDFIFN=0:0 S IBDFIFN=$O(^ICD9(IBDFIFN)) Q:'IBDFIFN S IBDFNODE=$$ICDDX^ICDCODE(IBDFIFN) I '$P(IBDFNODE,U,10) D
S IBDFIFN="" F S IBDFIFN=$O(^TMP("IBDICD9",$J,"DILIST","ICD",IBDFIFN)) Q:IBDFIFN="" S IBDFNODE=^TMP("IBDICD9",$J,"DILIST","ICD",IBDFIFN) D
.S IBDFCODE=$P(IBDFNODE,"^",2),IBDFDESC=$P(IBDFNODE,"^",4),IBDFCAT=$S($P(IBDFNODE,"^",6)]""&($G(^ICM(+$P(IBDFNODE,"^",6),0))]""):$P(^ICM($P(IBDFNODE,"^",6),0),"^",1),1:"UNKNOWN") D ALPHA
D LOOP
Q
;
ICD10 ;
;Use ICD API to check the status for CSV. No date is passed so the
;default day is DT (today). $P10 = status 0-inactive 1-active 2-inactive
D ICD10LST
S IBDFIFN=0 F S IBDFIFN=$O(^TMP("IBDICD10",$J,"DILIST","ICD",IBDFIFN)) Q:IBDFIFN="" S IBDFNODE=^TMP("IBDICD10",$J,"DILIST","ICD",IBDFIFN) D
.S IBDFCODE=$P(IBDFNODE,"^",2),IBDFDESC=$P(IBDFNODE,"^",4),IBDFCAT=$S($P(IBDFNODE,"^",6)]""&($G(^ICM(+$P(IBDFNODE,"^",6),0))]""):$P(^ICM($P(IBDFNODE,"^",6),0),"^",1),1:"UNKNOWN") D ALPHA
D LOOP
Q
;
VISIT ; -- Gets visit code listing of invalid codes
N IEN
F IBDFVST=0:0 S IBDFVST=$O(^IBE(357.69,"B",IBDFVST)) Q:'IBDFVST D
. S IEN=$O(^IBE(357.69,"B",IBDFVST,0))
. Q:'IEN
. S IBDFNODE=$$CPT^ICPTCOD(IBDFVST)
. Q:$P(IBDFNODE,U,7)=1 ;(CSV) status 0-inactive 1-active
. ;;Q:+IBDFNODE=-1
. S IBDFIFN=+IBDFNODE
. S IBDFCODE=$P(IBDFNODE,"^",2)
. S IBDFDESC=$P(IBDFNODE,"^",3)
. S IBDFCAT=$S($P(IBDFNODE,"^",4)]"":$P(^DIC(81.1,$P(IBDFNODE,"^",4),0),"^",1),1:"UNKNOWN")
. D ALPHA
D LOOP
Q
;
;
LOOP ; -- Loop thru global ^TMP("IBDALPHA",$J) alphabetic by category
I '$D(^TMP("IBDALPHA",$J)),IBDFDIS="ICD10" D Q ;
.S X="There are no ICD10 invalid code lists on file."
.S IBDCNT1=IBDCNT1+1,VALMCNT=VALMCNT+1
.S ^TMP("IBDCODE",$J,2,0)=X
.S ^TMP("IBDCODE",$J,"IDX",VALMCNT,IBDCNT1)=""
S IBDFCAT=0
F IBDCAT=0:0 S IBDFCAT=$O(^TMP("IBDALPHA",$J,IBDFCAT)) Q:IBDFCAT']"" F IBDFIFN=0:0 S IBDFIFN=$O(^TMP("IBDALPHA",$J,IBDFCAT,IBDFIFN)) Q:'IBDFIFN S IBDFNODE=$G(^TMP("IBDALPHA",$J,IBDFCAT,IBDFIFN)) D
.S IBDFIFN=$P(IBDFNODE,"^",1)
.S IBDFCODE=$P(IBDFNODE,"^",2)
.S IBDFCAT=$P(IBDFNODE,"^",3)
.S IBDFDESC=$P(IBDFNODE,"^",4)
.D:'$D(IBDFC(IBDFCAT)) HEADER^IBDFLST1 D SET
Q
;
;
SET ; -- Set up list array
S IBDCNT1=IBDCNT1+1
S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
S X=""
S IBDFVAL=$J(IBDCNT1_")",7)
S X=$$SETSTR(IBDFVAL,X,1,7)
S IBDFVAL=IBDFCODE
S X=$$SETSTR(IBDFVAL,X,9,8)
S IBDFVAL=IBDFDESC
S X=$$SETSTR(IBDFVAL,X,19,20)
S IBDFVAL=IBDFCAT
S X=$$SETSTR(IBDFVAL,X,41,20)
;
;
TMP ; -- Set up Array
S ^TMP("IBDCODE",$J,IBDCNT,0)=$S($G(IBDFDIS)["ICD9":X,$G(IBDFDIS)["ICD10":X,1:$$LOWER^VALM1(X))
S ^TMP("IBDCODE",$J,"IDX",VALMCNT,IBDCNT1)=""
S ^TMP("CODEIDX",$J,IBDCNT1)=VALMCNT_"^"_IBDFIFN_"^"_IBDFCODE_"^"_IBDFCAT_"^"_IBDFDESC
Q
;
;
ALPHA ; - Alphabetize by category
S ^TMP("IBDALPHA",$J,IBDFCAT,IBDFIFN)=IBDFIFN_"^"_IBDFCODE_"^"_IBDFCAT_"^"_IBDFDESC
Q
;
;
QUIT ; -- Kill variables and reset to last display if no change has been taken place.
;
;
EXIT K ^TMP("IBDCODE",$J),^TMP("CODEIDX",$J),^TMP("IBDALPHA",$J),^TMP("IBDICD9",$J),^TMP("IBDICD10",$J)
K ^TMP("IBDMSG9"),^TMP("IBDMSG10")
K IBDFC,IBDFTYP,IBDFCNT1,IBDCAT
Q
;
;
JUMP ; -- Jump action to display a specific category on the screen.
D FULL^VALM1
I $D(XQORNOD(0)),$P(XQORNOD(0),"^",4)]"" S X=$P(XQORNOD(0),"^",4) S X=$P(X,"=",2) I X]"" D:X?1.6N JSEL S DIC=$S(IBDFDIS="ICD9":"^ICM(",1:"^DIC(81.1,"),DIC(0)="QEZ" D ^DIC K DIC G:Y<0 JMP S Y=+Y D JUMP1 Q
JMP S DIC=$S(IBDFDIS="ICD9":"^ICM(",1:"^DIC(81.1,"),DIC(0)="AEMN",DIC("A")="Select "_$S(IBDFDIS="ICD9":"ICD9",1:"CPT")_" category you wish to move to: "
D ^DIC K DIC
I X["^" S VALMBG=1,VALMBCK="R" Q
;
;
JUMP1 I Y<0 G JUMP
N IBDFCAT
S IBDFCAT=$S(IBDFDIS="ICD9":$P(^ICM(+Y,0),"^",1),1:$P(^DIC(81.1,+Y,0),"^",1))
I '$D(IBDFC(IBDFCAT)) W !!,"There is no data listed for this Clinic Group" G JMP
S VALMBG=+IBDFC(IBDFCAT) S VALMBCK="R" Q
Q
;
;
JSEL ; -- Convert number selected to name
S IBDVALM=X I $D(^TMP("CGIDX",$J,IBDVALM)) S X=$P(^TMP("CGIDX",$J,IBDVALM),"^",2),X=$P(^IBD(357.99,X,0),"^",1)
Q
HLP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
;NEW CODE
; ICD-9 ICR 2051/5745 (by subscription)
ICD9LST ;
N IBDSCREN
K ^TMP("IBDICD9",$J)
S IBDSCREN="N ICD S ICD=$$ICDDX^ICDEX(+Y,$G(DT),1,""I"") I $P(ICD,U,10)=""0"",$P(ICD,U,12)?7N,$P(ICD,U,20)=1 S ^TMP(""IBDICD9"",$J,""DILIST"",""ICD"",+Y)=ICD"
D LIST^DIC(80,,,,,,,,IBDSCREN,,"^TMP(""IBDICD9"",$J)","^TMP(""IBDMSG9"",$J)")
Q
;;
; ICD-10 ICR 2051/5745 (by subscription)
;This returns no entries since there are no invalid ICD-10 codes
ICD10LST ;
N IBDSCREN
K ^TMP("IBDICD10",$J)
S IBDSCREN="N STATUS S STATUS=$$STATCHK^IBDUTICD(""10D"",+Y,$G(DT)) I STATUS=0!(STATUS=2) N ICD S ICD=$$ICDDATA^ICDXCODE(""10D"",+Y,$G(DT)) I $P(ICD,U,20)=30 S ^TMP(""IBDICD10"",$J,""DILIST"",""ICD"",+Y)=ICD"
D LIST^DIC(80,,,,,,,,IBDSCREN,,"^TMP(""IBDICD10"",$J)","^TMP(""IBDMSG10"",$J)")
Q
;IBDFLST
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFLST 7201 printed Dec 13, 2024@02:52:43 Page 2
IBDFLST ;ALM/MAF - Maintenance Utility Invalid Codes List ;05/17/95
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**9,38,51,63**;APR 24, 1997;Build 80
+2 ;
+3 ;
+4 ;
START ; -- Ask what invalid code you want to display CPT/ ICD9/ Visit
+1 NEW IBDFDIS
+2 DO FULL^VALM1
+3 SET DIR("B")="CPT"
+4 ;
+5 SET DIR(0)="SA^C:CPT;I:ICD9;D:ICD10;V:VISIT"
SET DIR("A")="Display invalid codes for [C]PT, [I]CD9, IC[D]10, [V]ISIT: "
DO ^DIR
+6 KILL DIR
IF $DATA(DIRUT)!(Y<0)
GOTO QUIT
+7 ;W !!,"Display invalid codes for CPT// " D ZSET1^IBDFLST1 S X="" R X:DTIME G QUIT:X="^"!('$T) I X=""!("Cc"[X) S X="1"
+8 ;
SET X=$SELECT("Ii"[X:2,"Dd"[X:3,"Vv"[X:4,1:1)
+9 ;I X="?" D ZSET1^IBDFLST1,HELP1^IBDFLST1 G START
+10 ; D IN^DGHELP W ! I %=-1 D ZSET1^IBDFLST1,HELP1^IBDFLST1 G START
SET IBDFTYP=$EXTRACT(X)
+11 SET IBDFDIS=$SELECT(IBDFTYP=1:"CPT",IBDFTYP=2:"ICD9",IBDFTYP=3:"ICD10",IBDFTYP=4:"VISIT",1:"QUIT")
+12 DO WAIT^DICD
+13 DO EN^VALM("IBDF UTIL COMPLETE LIST TEMP")
+14 QUIT
+15 ;
+16 ;
HDR ; -- header code
+1 SET VALMHDR(1)="This screen displays the most current invalid codes for the "_IBDFDIS_" file."
+2 QUIT
+3 ;
+4 ;
SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
+1 ; S := string
+2 ; V := destination
+3 ; X := @ col X
+4 ; L := # of chars
+5 ;
+6 QUIT $EXTRACT(V_$JUSTIFY("",X-1),1,X-1)_$EXTRACT(S_$JUSTIFY("",L),1,L)_$EXTRACT(V,X+L,999)
+7 ;
+8 ;
INIT ; -- Set up list for display
+1 NEW IBDFCODE,IBDFDESC,IBDFIFN,IBDFCAT,IBDFNODE
+2 SET (IBDCNT,VALMCNT,IBDCNT1)=0
+3 DO @(IBDFDIS)
+4 QUIT
+5 ;
+6 ; -- Gets CPT listing of invalid codes
CPT DO FULL^VALM1
FOR IBDFIFN=0:0
SET IBDFIFN=$ORDER(^ICPT(IBDFIFN))
if 'IBDFIFN
QUIT
Begin DoDot:1
+1 ;; --change to api cpt ; dhh
+2 ;; --note: 7th piece is status 0-inactive 1-active
+3 SET IBDFNODE=$$CPT^ICPTCOD(IBDFIFN)
SET IBDFNODE=$GET(IBDFNODE)
+4 IF $PIECE(IBDFNODE,"^",7)=0
Begin DoDot:2
+5 SET IBDFCODE=$PIECE(IBDFNODE,"^",2)
SET IBDFDESC=$PIECE(IBDFNODE,"^",3)
+6 SET IBDFCAT=$SELECT($PIECE(IBDFNODE,"^",4)]"":$PIECE(^DIC(81.1,$PIECE(IBDFNODE,"^",4),0),"^",1),1:"UNKNOWN")
DO ALPHA
End DoDot:2
End DoDot:1
+7 DO LOOP
+8 QUIT
+9 ;
+10 ; -- Gets ICD9 listing of invalid codes
+11 ; -- Use api for ICD9
ICD9 ;;F IBDFIFN=0:0 S IBDFIFN=$O(^ICD9(IBDFIFN)) Q:'IBDFIFN S IBDFNODE=$G(^ICD9(IBDFIFN,0)) I $P(IBDFNODE,"^",9)]"" D
+1 ;
+2 ;Use ICD API to check the status for CSV. No date is passed so the
+3 ;default day is DT (today). $P10 = status 0-inactive 1-active
+4 DO ICD9LST
+5 ;F IBDFIFN=0:0 S IBDFIFN=$O(^ICD9(IBDFIFN)) Q:'IBDFIFN S IBDFNODE=$$ICDDX^ICDCODE(IBDFIFN) I '$P(IBDFNODE,U,10) D
+6 SET IBDFIFN=""
FOR
SET IBDFIFN=$ORDER(^TMP("IBDICD9",$JOB,"DILIST","ICD",IBDFIFN))
if IBDFIFN=""
QUIT
SET IBDFNODE=^TMP("IBDICD9",$JOB,"DILIST","ICD",IBDFIFN)
Begin DoDot:1
+7 SET IBDFCODE=$PIECE(IBDFNODE,"^",2)
SET IBDFDESC=$PIECE(IBDFNODE,"^",4)
SET IBDFCAT=$SELECT($PIECE(IBDFNODE,"^",6)]""&($GET(^ICM(+$PIECE(IBDFNODE,"^",6),0))]""):$PIECE(^ICM($PIECE(IBDFNODE,"^",6),0),"^",1),1:"UNKNOWN")
DO ALPHA
End DoDot:1
+8 DO LOOP
+9 QUIT
+10 ;
ICD10 ;
+1 ;Use ICD API to check the status for CSV. No date is passed so the
+2 ;default day is DT (today). $P10 = status 0-inactive 1-active 2-inactive
+3 DO ICD10LST
+4 SET IBDFIFN=0
FOR
SET IBDFIFN=$ORDER(^TMP("IBDICD10",$JOB,"DILIST","ICD",IBDFIFN))
if IBDFIFN=""
QUIT
SET IBDFNODE=^TMP("IBDICD10",$JOB,"DILIST","ICD",IBDFIFN)
Begin DoDot:1
+5 SET IBDFCODE=$PIECE(IBDFNODE,"^",2)
SET IBDFDESC=$PIECE(IBDFNODE,"^",4)
SET IBDFCAT=$SELECT($PIECE(IBDFNODE,"^",6)]""&($GET(^ICM(+$PIECE(IBDFNODE,"^",6),0))]""):$PIECE(^ICM($PIECE(IBDFNODE,"^",6),0),"^",1),1:"UNKNOWN")
DO ALPHA
End DoDot:1
+6 DO LOOP
+7 QUIT
+8 ;
VISIT ; -- Gets visit code listing of invalid codes
+1 NEW IEN
+2 FOR IBDFVST=0:0
SET IBDFVST=$ORDER(^IBE(357.69,"B",IBDFVST))
if 'IBDFVST
QUIT
Begin DoDot:1
+3 SET IEN=$ORDER(^IBE(357.69,"B",IBDFVST,0))
+4 if 'IEN
QUIT
+5 SET IBDFNODE=$$CPT^ICPTCOD(IBDFVST)
+6 ;(CSV) status 0-inactive 1-active
if $PIECE(IBDFNODE,U,7)=1
QUIT
+7 ;;Q:+IBDFNODE=-1
+8 SET IBDFIFN=+IBDFNODE
+9 SET IBDFCODE=$PIECE(IBDFNODE,"^",2)
+10 SET IBDFDESC=$PIECE(IBDFNODE,"^",3)
+11 SET IBDFCAT=$SELECT($PIECE(IBDFNODE,"^",4)]"":$PIECE(^DIC(81.1,$PIECE(IBDFNODE,"^",4),0),"^",1),1:"UNKNOWN")
+12 DO ALPHA
End DoDot:1
+13 DO LOOP
+14 QUIT
+15 ;
+16 ;
LOOP ; -- Loop thru global ^TMP("IBDALPHA",$J) alphabetic by category
+1 ;
IF '$DATA(^TMP("IBDALPHA",$JOB))
IF IBDFDIS="ICD10"
Begin DoDot:1
+2 SET X="There are no ICD10 invalid code lists on file."
+3 SET IBDCNT1=IBDCNT1+1
SET VALMCNT=VALMCNT+1
+4 SET ^TMP("IBDCODE",$JOB,2,0)=X
+5 SET ^TMP("IBDCODE",$JOB,"IDX",VALMCNT,IBDCNT1)=""
End DoDot:1
QUIT
+6 SET IBDFCAT=0
+7 FOR IBDCAT=0:0
SET IBDFCAT=$ORDER(^TMP("IBDALPHA",$JOB,IBDFCAT))
if IBDFCAT']""
QUIT
FOR IBDFIFN=0:0
SET IBDFIFN=$ORDER(^TMP("IBDALPHA",$JOB,IBDFCAT,IBDFIFN))
if 'IBDFIFN
QUIT
SET IBDFNODE=$GET(^TMP("IBDALPHA",$JOB,IBDFCAT,IBDFIFN))
Begin DoDot:1
+8 SET IBDFIFN=$PIECE(IBDFNODE,"^",1)
+9 SET IBDFCODE=$PIECE(IBDFNODE,"^",2)
+10 SET IBDFCAT=$PIECE(IBDFNODE,"^",3)
+11 SET IBDFDESC=$PIECE(IBDFNODE,"^",4)
+12 if '$DATA(IBDFC(IBDFCAT))
DO HEADER^IBDFLST1
DO SET
End DoDot:1
+13 QUIT
+14 ;
+15 ;
SET ; -- Set up list array
+1 SET IBDCNT1=IBDCNT1+1
+2 SET IBDCNT=IBDCNT+1
SET VALMCNT=VALMCNT+1
+3 SET X=""
+4 SET IBDFVAL=$JUSTIFY(IBDCNT1_")",7)
+5 SET X=$$SETSTR(IBDFVAL,X,1,7)
+6 SET IBDFVAL=IBDFCODE
+7 SET X=$$SETSTR(IBDFVAL,X,9,8)
+8 SET IBDFVAL=IBDFDESC
+9 SET X=$$SETSTR(IBDFVAL,X,19,20)
+10 SET IBDFVAL=IBDFCAT
+11 SET X=$$SETSTR(IBDFVAL,X,41,20)
+12 ;
+13 ;
TMP ; -- Set up Array
+1 SET ^TMP("IBDCODE",$JOB,IBDCNT,0)=$SELECT($GET(IBDFDIS)["ICD9":X,$GET(IBDFDIS)["ICD10":X,1:$$LOWER^VALM1(X))
+2 SET ^TMP("IBDCODE",$JOB,"IDX",VALMCNT,IBDCNT1)=""
+3 SET ^TMP("CODEIDX",$JOB,IBDCNT1)=VALMCNT_"^"_IBDFIFN_"^"_IBDFCODE_"^"_IBDFCAT_"^"_IBDFDESC
+4 QUIT
+5 ;
+6 ;
ALPHA ; - Alphabetize by category
+1 SET ^TMP("IBDALPHA",$JOB,IBDFCAT,IBDFIFN)=IBDFIFN_"^"_IBDFCODE_"^"_IBDFCAT_"^"_IBDFDESC
+2 QUIT
+3 ;
+4 ;
QUIT ; -- Kill variables and reset to last display if no change has been taken place.
+1 ;
+2 ;
EXIT KILL ^TMP("IBDCODE",$JOB),^TMP("CODEIDX",$JOB),^TMP("IBDALPHA",$JOB),^TMP("IBDICD9",$JOB),^TMP("IBDICD10",$JOB)
+1 KILL ^TMP("IBDMSG9"),^TMP("IBDMSG10")
+2 KILL IBDFC,IBDFTYP,IBDFCNT1,IBDCAT
+3 QUIT
+4 ;
+5 ;
JUMP ; -- Jump action to display a specific category on the screen.
+1 DO FULL^VALM1
+2 IF $DATA(XQORNOD(0))
IF $PIECE(XQORNOD(0),"^",4)]""
SET X=$PIECE(XQORNOD(0),"^",4)
SET X=$PIECE(X,"=",2)
IF X]""
if X?1.6N
DO JSEL
SET DIC=$SELECT(IBDFDIS="ICD9":"^ICM(",1:"^DIC(81.1,")
SET DIC(0)="QEZ"
DO ^DIC
KILL DIC
if Y<0
GOTO JMP
SET Y=+Y
DO JUMP1
QUIT
JMP SET DIC=$SELECT(IBDFDIS="ICD9":"^ICM(",1:"^DIC(81.1,")
SET DIC(0)="AEMN"
SET DIC("A")="Select "_$SELECT(IBDFDIS="ICD9":"ICD9",1:"CPT")_" category you wish to move to: "
+1 DO ^DIC
KILL DIC
+2 IF X["^"
SET VALMBG=1
SET VALMBCK="R"
QUIT
+3 ;
+4 ;
JUMP1 IF Y<0
GOTO JUMP
+1 NEW IBDFCAT
+2 SET IBDFCAT=$SELECT(IBDFDIS="ICD9":$PIECE(^ICM(+Y,0),"^",1),1:$PIECE(^DIC(81.1,+Y,0),"^",1))
+3 IF '$DATA(IBDFC(IBDFCAT))
WRITE !!,"There is no data listed for this Clinic Group"
GOTO JMP
+4 SET VALMBG=+IBDFC(IBDFCAT)
SET VALMBCK="R"
QUIT
+5 QUIT
+6 ;
+7 ;
JSEL ; -- Convert number selected to name
+1 SET IBDVALM=X
IF $DATA(^TMP("CGIDX",$JOB,IBDVALM))
SET X=$PIECE(^TMP("CGIDX",$JOB,IBDVALM),"^",2)
SET X=$PIECE(^IBD(357.99,X,0),"^",1)
+2 QUIT
HLP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
+4 ;NEW CODE
+5 ; ICD-9 ICR 2051/5745 (by subscription)
ICD9LST ;
+1 NEW IBDSCREN
+2 KILL ^TMP("IBDICD9",$JOB)
+3 SET IBDSCREN="N ICD S ICD=$$ICDDX^ICDEX(+Y,$G(DT),1,""I"") I $P(ICD,U,10)=""0"",$P(ICD,U,12)?7N,$P(ICD,U,20)=1 S ^TMP(""IBDICD9"",$J,""DILIST"",""ICD"",+Y)=ICD"
+4 DO LIST^DIC(80,,,,,,,,IBDSCREN,,"^TMP(""IBDICD9"",$J)","^TMP(""IBDMSG9"",$J)")
+5 QUIT
+6 ;;
+7 ; ICD-10 ICR 2051/5745 (by subscription)
+8 ;This returns no entries since there are no invalid ICD-10 codes
ICD10LST ;
+1 NEW IBDSCREN
+2 KILL ^TMP("IBDICD10",$JOB)
+3 SET IBDSCREN="N STATUS S STATUS=$$STATCHK^IBDUTICD(""10D"",+Y,$G(DT)) I STATUS=0!(STATUS=2) N ICD S ICD=$$ICDDATA^ICDXCODE(""10D"",+Y,$G(DT)) I $P(ICD,U,20)=30 S ^TMP(""IBDICD10"",$J,""DILIST"",""ICD"",+Y)=ICD"
+4 DO LIST^DIC(80,,,,,,,,IBDSCREN,,"^TMP(""IBDICD10"",$J)","^TMP(""IBDMSG10"",$J)")
+5 QUIT
+6 ;IBDFLST
