Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBDFLST

IBDFLST.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1.  ;
  1. START ;  -- Ask what invalid code you want to display CPT/ ICD9/ Visit
  1.  N IBDFDIS
  1.  D FULL^VALM1
  1.  S DIR("B")="CPT"
  1.  ;
  1.  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
  1.  K DIR I $D(DIRUT)!(Y<0) G QUIT
  1.  ;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"
  1.  S X=$S("Ii"[X:2,"Dd"[X:3,"Vv"[X:4,1:1) ; 
  1.  ;I X="?" D ZSET1^IBDFLST1,HELP1^IBDFLST1 G START
  1.  S IBDFTYP=$E(X)  ; D IN^DGHELP W ! I %=-1 D ZSET1^IBDFLST1,HELP1^IBDFLST1 G START
  1.  S IBDFDIS=$S(IBDFTYP=1:"CPT",IBDFTYP=2:"ICD9",IBDFTYP=3:"ICD10",IBDFTYP=4:"VISIT",1:"QUIT")
  1.  D WAIT^DICD
  1.  D EN^VALM("IBDF UTIL COMPLETE LIST TEMP")
  1.  Q
  1.  ;
  1.  ;
  1. HDR ; -- header code
  1.  S VALMHDR(1)="This screen displays the most current invalid codes for the "_IBDFDIS_" file."
  1.  Q
  1.  ;
  1.  ;
  1. SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
  1.  ;    S := string
  1.  ;    V := destination
  1.  ;    X := @ col X
  1.  ;    L := # of chars
  1.  ;
  1.  Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
  1.  ;
  1.  ;
  1. INIT ;  -- Set up list for display
  1.  N IBDFCODE,IBDFDESC,IBDFIFN,IBDFCAT,IBDFNODE
  1.  S (IBDCNT,VALMCNT,IBDCNT1)=0
  1.  D @(IBDFDIS)
  1.  Q
  1.  ;
  1.  ;  -- Gets CPT listing of invalid codes
  1. CPT D FULL^VALM1 F IBDFIFN=0:0 S IBDFIFN=$O(^ICPT(IBDFIFN)) Q:'IBDFIFN  D
  1.  .;; --change to api cpt ; dhh
  1.  .;;     --note: 7th piece is status 0-inactive 1-active
  1.  . S IBDFNODE=$$CPT^ICPTCOD(IBDFIFN),IBDFNODE=$G(IBDFNODE)
  1.  . I $P(IBDFNODE,"^",7)=0 D
  1.  .. S IBDFCODE=$P(IBDFNODE,"^",2),IBDFDESC=$P(IBDFNODE,"^",3)
  1.  .. S IBDFCAT=$S($P(IBDFNODE,"^",4)]"":$P(^DIC(81.1,$P(IBDFNODE,"^",4),0),"^",1),1:"UNKNOWN") D ALPHA
  1.  D LOOP
  1.  Q
  1.  ;
  1.  ;  -- Gets ICD9 listing of invalid codes
  1.  ;  -- Use api for ICD9
  1. ICD9 ;;F IBDFIFN=0:0 S IBDFIFN=$O(^ICD9(IBDFIFN)) Q:'IBDFIFN  S IBDFNODE=$G(^ICD9(IBDFIFN,0)) I $P(IBDFNODE,"^",9)]"" D
  1.  ;
  1.  ;Use ICD API to check the status for CSV.  No date is passed so the
  1.  ;default day is DT (today).  $P10 = status 0-inactive 1-active
  1.  D ICD9LST
  1.  ;F IBDFIFN=0:0 S IBDFIFN=$O(^ICD9(IBDFIFN)) Q:'IBDFIFN  S IBDFNODE=$$ICDDX^ICDCODE(IBDFIFN) I '$P(IBDFNODE,U,10) D
  1.  S IBDFIFN="" F  S IBDFIFN=$O(^TMP("IBDICD9",$J,"DILIST","ICD",IBDFIFN)) Q:IBDFIFN=""  S IBDFNODE=^TMP("IBDICD9",$J,"DILIST","ICD",IBDFIFN) D
  1.  .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
  1.  D LOOP
  1.  Q
  1.  ;
  1. ICD10 ;
  1.  ;Use ICD API to check the status for CSV. No date is passed so the
  1.  ;default day is DT (today). $P10 = status 0-inactive 1-active 2-inactive
  1.  D ICD10LST
  1.  S IBDFIFN=0 F  S IBDFIFN=$O(^TMP("IBDICD10",$J,"DILIST","ICD",IBDFIFN)) Q:IBDFIFN=""  S IBDFNODE=^TMP("IBDICD10",$J,"DILIST","ICD",IBDFIFN) D
  1.  .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
  1.  D LOOP
  1.  Q
  1.  ;
  1. VISIT ;  -- Gets visit code listing of invalid codes
  1.  N IEN
  1.  F IBDFVST=0:0 S IBDFVST=$O(^IBE(357.69,"B",IBDFVST)) Q:'IBDFVST  D
  1.  . S IEN=$O(^IBE(357.69,"B",IBDFVST,0))
  1.  . Q:'IEN
  1.  . S IBDFNODE=$$CPT^ICPTCOD(IBDFVST)
  1.  . Q:$P(IBDFNODE,U,7)=1  ;(CSV) status 0-inactive 1-active
  1.  . ;;Q:+IBDFNODE=-1
  1.  . S IBDFIFN=+IBDFNODE
  1.  . S IBDFCODE=$P(IBDFNODE,"^",2)
  1.  . S IBDFDESC=$P(IBDFNODE,"^",3)
  1.  . S IBDFCAT=$S($P(IBDFNODE,"^",4)]"":$P(^DIC(81.1,$P(IBDFNODE,"^",4),0),"^",1),1:"UNKNOWN")
  1.  . D ALPHA
  1.  D LOOP
  1.  Q
  1.  ;
  1.  ;
  1. LOOP ;  -- Loop thru global ^TMP("IBDALPHA",$J) alphabetic by category
  1.  I '$D(^TMP("IBDALPHA",$J)),IBDFDIS="ICD10" D  Q  ;
  1.  .S X="There are no ICD10 invalid code lists on file."
  1.  .S IBDCNT1=IBDCNT1+1,VALMCNT=VALMCNT+1
  1.  .S ^TMP("IBDCODE",$J,2,0)=X
  1.  .S ^TMP("IBDCODE",$J,"IDX",VALMCNT,IBDCNT1)=""
  1.  S IBDFCAT=0
  1.  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
  1.  .S IBDFIFN=$P(IBDFNODE,"^",1)
  1.  .S IBDFCODE=$P(IBDFNODE,"^",2)
  1.  .S IBDFCAT=$P(IBDFNODE,"^",3)
  1.  .S IBDFDESC=$P(IBDFNODE,"^",4)
  1.  .D:'$D(IBDFC(IBDFCAT)) HEADER^IBDFLST1 D SET
  1.  Q
  1.  ;
  1.  ;
  1. SET ;  -- Set up list array
  1.  S IBDCNT1=IBDCNT1+1
  1.  S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
  1.  S X=""
  1.  S IBDFVAL=$J(IBDCNT1_")",7)
  1.  S X=$$SETSTR(IBDFVAL,X,1,7)
  1.  S IBDFVAL=IBDFCODE
  1.  S X=$$SETSTR(IBDFVAL,X,9,8)
  1.  S IBDFVAL=IBDFDESC
  1.  S X=$$SETSTR(IBDFVAL,X,19,20)
  1.  S IBDFVAL=IBDFCAT
  1.  S X=$$SETSTR(IBDFVAL,X,41,20)
  1.  ;
  1.  ;
  1. TMP ; -- Set up Array
  1.  S ^TMP("IBDCODE",$J,IBDCNT,0)=$S($G(IBDFDIS)["ICD9":X,$G(IBDFDIS)["ICD10":X,1:$$LOWER^VALM1(X))
  1.  S ^TMP("IBDCODE",$J,"IDX",VALMCNT,IBDCNT1)=""
  1.  S ^TMP("CODEIDX",$J,IBDCNT1)=VALMCNT_"^"_IBDFIFN_"^"_IBDFCODE_"^"_IBDFCAT_"^"_IBDFDESC
  1.  Q
  1.  ;
  1.  ;
  1. ALPHA ;  - Alphabetize by category
  1.  S ^TMP("IBDALPHA",$J,IBDFCAT,IBDFIFN)=IBDFIFN_"^"_IBDFCODE_"^"_IBDFCAT_"^"_IBDFDESC
  1.  Q
  1.  ;
  1.  ;
  1. QUIT ;  -- Kill variables and reset to last display if no change has been taken place.
  1.  ;
  1.  ;
  1. EXIT K ^TMP("IBDCODE",$J),^TMP("CODEIDX",$J),^TMP("IBDALPHA",$J),^TMP("IBDICD9",$J),^TMP("IBDICD10",$J)
  1.  K ^TMP("IBDMSG9"),^TMP("IBDMSG10")
  1.  K IBDFC,IBDFTYP,IBDFCNT1,IBDCAT
  1.  Q
  1.  ;
  1.  ;
  1. JUMP ; -- Jump action to display a specific category on the screen.
  1.  D FULL^VALM1
  1.  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
  1. 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: "
  1.  D ^DIC K DIC
  1.  I X["^" S VALMBG=1,VALMBCK="R" Q
  1.  ;
  1.  ;
  1. JUMP1 I Y<0 G JUMP
  1.  N IBDFCAT
  1.  S IBDFCAT=$S(IBDFDIS="ICD9":$P(^ICM(+Y,0),"^",1),1:$P(^DIC(81.1,+Y,0),"^",1))
  1.  I '$D(IBDFC(IBDFCAT)) W !!,"There is no data listed for this Clinic Group" G JMP
  1.  S VALMBG=+IBDFC(IBDFCAT) S VALMBCK="R" Q
  1.  Q
  1.  ;
  1.  ;
  1. JSEL ; -- Convert number selected to name
  1.  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)
  1.  Q
  1. HLP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1.  ;NEW CODE
  1.  ; ICD-9 ICR 2051/5745 (by subscription) 
  1. ICD9LST ;
  1.  N IBDSCREN
  1.  K ^TMP("IBDICD9",$J)
  1.  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"
  1.  D LIST^DIC(80,,,,,,,,IBDSCREN,,"^TMP(""IBDICD9"",$J)","^TMP(""IBDMSG9"",$J)")
  1.  Q
  1.  ;;
  1.  ; ICD-10 ICR 2051/5745 (by subscription) 
  1.  ;This returns no entries since there are no invalid ICD-10 codes
  1. ICD10LST ;
  1.  N IBDSCREN
  1.  K ^TMP("IBDICD10",$J)
  1.  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"
  1.  D LIST^DIC(80,,,,,,,,IBDSCREN,,"^TMP(""IBDICD10"",$J)","^TMP(""IBDMSG10"",$J)")
  1.  Q
  1.  ;IBDFLST