IBDFN7 ;ALB/CJM - ENCOUNTER FORM - validate logic for data ;05/10/95
;;3.0;AUTOMATED INFO COLLECTION SYS;**38,51,64,63**;APR 24, 1997;Build 80
;
;
TESTCPT ;does X point to a valid CPT4 code? Kills X if not.
;
;;change to api cpt;dhh
N XX
S Y=""
I $G(X)="" K X Q
S XX=$$CPT^ICPTCOD($G(X))
I +XX=-1 K X Q
I $P(XX,U,7)'=1 K X S Y=$P(XX,U,3) Q
S X=$P(XX,U) ;set X equal ien of cpt code
Q
;
TESTICD ; -- does X point to a valid ICD-9 code? Kills X if not.
; -- input the icd code in X
;
N IBDCODE,IBDSTAT
I $G(X)="" K X S Y="" Q
;S:$E(X,$L(X))'=" " X=X_" " ; use ba xref, add space to end for lookup.
;S X=$O(^ICD9("BA",X,0)) I 'X K X S Y="" Q
;I '$D(^ICD9(X,0)) K X S Y="" Q
;;I $P($G(^ICD9(X,0)),"^",9) S Y=$P(^ICD9(X,0),"^",3) K X
;S IBDCODE=$$ICDDX^ICDCODE(X)
S IBDCODE=$$ICDDATA^ICDXCODE("ICD9",X,DT) S X=$P(IBDCODE,U) I 'X!(X<1) K X S Y="" Q
S IBDSTAT=$P(IBDCODE,U,10) I IBDSTAT'=1 S Y=$P(IBDCODE,U,4) K X
S IBDY=$P(IBDCODE,U,4)
Q
;
TESTICD0 ;
;-- does X point to a valid ICD-10 code? Kills X if not.
;-- input the icd code in X
;
;DT = Today's date
;
;STATUS:
; 0 = Inactive - ICD-10 Code is Inactive due to today's date being less than Active date.
; Example: Today's date = 10/01/2013; ICD-10 code Active date = 10/01/2014
; 10/01/2013 is less than 10/01/2014
;
; 1 = Active - ICD-10 Code is Active due to today's date being greater than or equal to Active date.
; Example: Today's date = 10/02/2014; ICD-10 code Active date = 10/01/2014
; 10/02/2014 is greater than 10/01/2014
; Example: Today's date = 10/01/2014; ICD-10 code Active date = 10/01/2014
; 10/01/2014 is equal to Active date 10/01/2014
;
; 2 = Inactive - ICD-10 Code is Inactive due to today's date being less than Implementation date.
; Example: Today's date = 09/30/2013; ICD-10 code Implementation date = 10/01/2013;
; 09/30/2013 is less than 10/01/2013
;
N IBDCODE,IBDSTAT,IBDTEMPY
I $G(X)="" K X S Y="" Q
;S IBDCODE=$$ICDDATA^ICDXCODE("10D",X,DT) S X=$P(IBDCODE,U) I 'X!(X<1) K X S Y="" Q
;S IBDSTAT=$P(IBDCODE,U,10) I IBDSTAT'=1 S Y=$P(IBDCODE,U,4) K X
S IBDCODE=$$ICDDATA^ICDXCODE("10D",X,DT) S X=$P(IBDCODE,U) I 'X!(X<1) K X S Y="" Q
S IBDSTAT=$$STATCHK^IBDUTICD("10D",$P(IBDCODE,U,2),DT)
I IBDSTAT'=1 S Y=$P(IBDCODE,U,4) K X
S IBDY=$P(IBDCODE,U,4)
Q
;
;
TESTVST ;does X point to a valid visit code? If not, kills X.
;checks that X is a valid CPT4 code and that there is a corresponding entry in the TYPE OF VISIT file that is active
N IEN,XX
I $G(X)="" K X S Y="" Q
;;change to api cpt;dhh
S XX=$$CPT^ICPTCOD(X)
I +XX=-1 K X S Y="" Q
I $P(XX,U,7)'=1 K X S Y=$P(XX,U,3) Q
S X=$P(XX,U) ;set X equal ien of cpt code
Q:'$D(X)
S IEN=$O(^IBE(357.69,"B",X,0)) K:'IEN X I IEN K:$P($G(^IBE(357.69,IEN,0)),"^",4) X
Q
;
TESTLEX ; -- Is clinical lexicon pointer valid and does icdone, not return 799.9
N IBDIMP,IBDIBX
S IBDIMP=$$IMPDATE^IBDUTICD("10D"),IBDIBX=799.9
I DT'<IBDIMP S IBDIBX="R69."
S IBDLEXV=1
I $D(^LEX)>1 S X="LEXSET" X ^%ZOSF("TEST") I $T S IBDLEXV=2
I IBDLEXV=1 D
.I $G(X)="" K X S Y="" Q
.I '$D(^GMP(757.01,+X,0)) K X S Y="" Q
.S VAL=$$ICDONE^GMPTU(X)
.I VAL="" K X S Y="No ICD"_$S(DT'<IBDIMP:"10",1:"9")_" code" Q
.I VAL=IBDIBX K X S Y="ICD"_$S(DT'<IBDIMP:"10",1:"9")_" code "_IBDIBX Q
.I $G(X)="" K X S Y="" Q
.Q
I IBDLEXV>1 D
.I $G(X)="" K X S Y="" Q
.I '$D(^LEX(757.01,+X,0)) K X S Y="" Q
.S VAL=$$ICDONE^LEXU(X)
.I VAL="" K X S Y="No ICD"_$S(DT'<IBDIMP:"10",1:"9")_" code" Q
.I VAL=IBDIBX K X S Y="ICD"_$S(DT'<IBDIMP:"10",1:"9")_" code "_IBDIBX Q
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFN7 3663 printed Apr 09, 2024@21:54:08 Page 2
IBDFN7 ;ALB/CJM - ENCOUNTER FORM - validate logic for data ;05/10/95
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**38,51,64,63**;APR 24, 1997;Build 80
+2 ;
+3 ;
TESTCPT ;does X point to a valid CPT4 code? Kills X if not.
+1 ;
+2 ;;change to api cpt;dhh
+3 NEW XX
+4 SET Y=""
+5 IF $GET(X)=""
KILL X
QUIT
+6 SET XX=$$CPT^ICPTCOD($GET(X))
+7 IF +XX=-1
KILL X
QUIT
+8 IF $PIECE(XX,U,7)'=1
KILL X
SET Y=$PIECE(XX,U,3)
QUIT
+9 ;set X equal ien of cpt code
SET X=$PIECE(XX,U)
+10 QUIT
+11 ;
TESTICD ; -- does X point to a valid ICD-9 code? Kills X if not.
+1 ; -- input the icd code in X
+2 ;
+3 NEW IBDCODE,IBDSTAT
+4 IF $GET(X)=""
KILL X
SET Y=""
QUIT
+5 ;S:$E(X,$L(X))'=" " X=X_" " ; use ba xref, add space to end for lookup.
+6 ;S X=$O(^ICD9("BA",X,0)) I 'X K X S Y="" Q
+7 ;I '$D(^ICD9(X,0)) K X S Y="" Q
+8 ;;I $P($G(^ICD9(X,0)),"^",9) S Y=$P(^ICD9(X,0),"^",3) K X
+9 ;S IBDCODE=$$ICDDX^ICDCODE(X)
+10 SET IBDCODE=$$ICDDATA^ICDXCODE("ICD9",X,DT)
SET X=$PIECE(IBDCODE,U)
IF 'X!(X<1)
KILL X
SET Y=""
QUIT
+11 SET IBDSTAT=$PIECE(IBDCODE,U,10)
IF IBDSTAT'=1
SET Y=$PIECE(IBDCODE,U,4)
KILL X
+12 SET IBDY=$PIECE(IBDCODE,U,4)
+13 QUIT
+14 ;
TESTICD0 ;
+1 ;-- does X point to a valid ICD-10 code? Kills X if not.
+2 ;-- input the icd code in X
+3 ;
+4 ;DT = Today's date
+5 ;
+6 ;STATUS:
+7 ; 0 = Inactive - ICD-10 Code is Inactive due to today's date being less than Active date.
+8 ; Example: Today's date = 10/01/2013; ICD-10 code Active date = 10/01/2014
+9 ; 10/01/2013 is less than 10/01/2014
+10 ;
+11 ; 1 = Active - ICD-10 Code is Active due to today's date being greater than or equal to Active date.
+12 ; Example: Today's date = 10/02/2014; ICD-10 code Active date = 10/01/2014
+13 ; 10/02/2014 is greater than 10/01/2014
+14 ; Example: Today's date = 10/01/2014; ICD-10 code Active date = 10/01/2014
+15 ; 10/01/2014 is equal to Active date 10/01/2014
+16 ;
+17 ; 2 = Inactive - ICD-10 Code is Inactive due to today's date being less than Implementation date.
+18 ; Example: Today's date = 09/30/2013; ICD-10 code Implementation date = 10/01/2013;
+19 ; 09/30/2013 is less than 10/01/2013
+20 ;
+21 NEW IBDCODE,IBDSTAT,IBDTEMPY
+22 IF $GET(X)=""
KILL X
SET Y=""
QUIT
+23 ;S IBDCODE=$$ICDDATA^ICDXCODE("10D",X,DT) S X=$P(IBDCODE,U) I 'X!(X<1) K X S Y="" Q
+24 ;S IBDSTAT=$P(IBDCODE,U,10) I IBDSTAT'=1 S Y=$P(IBDCODE,U,4) K X
+25 SET IBDCODE=$$ICDDATA^ICDXCODE("10D",X,DT)
SET X=$PIECE(IBDCODE,U)
IF 'X!(X<1)
KILL X
SET Y=""
QUIT
+26 SET IBDSTAT=$$STATCHK^IBDUTICD("10D",$PIECE(IBDCODE,U,2),DT)
+27 IF IBDSTAT'=1
SET Y=$PIECE(IBDCODE,U,4)
KILL X
+28 SET IBDY=$PIECE(IBDCODE,U,4)
+29 QUIT
+30 ;
+31 ;
TESTVST ;does X point to a valid visit code? If not, kills X.
+1 ;checks that X is a valid CPT4 code and that there is a corresponding entry in the TYPE OF VISIT file that is active
+2 NEW IEN,XX
+3 IF $GET(X)=""
KILL X
SET Y=""
QUIT
+4 ;;change to api cpt;dhh
+5 SET XX=$$CPT^ICPTCOD(X)
+6 IF +XX=-1
KILL X
SET Y=""
QUIT
+7 IF $PIECE(XX,U,7)'=1
KILL X
SET Y=$PIECE(XX,U,3)
QUIT
+8 ;set X equal ien of cpt code
SET X=$PIECE(XX,U)
+9 if '$DATA(X)
QUIT
+10 SET IEN=$ORDER(^IBE(357.69,"B",X,0))
if 'IEN
KILL X
IF IEN
if $PIECE($GET(^IBE(357.69,IEN,0)),"^",4)
KILL X
+11 QUIT
+12 ;
TESTLEX ; -- Is clinical lexicon pointer valid and does icdone, not return 799.9
+1 NEW IBDIMP,IBDIBX
+2 SET IBDIMP=$$IMPDATE^IBDUTICD("10D")
SET IBDIBX=799.9
+3 IF DT'<IBDIMP
SET IBDIBX="R69."
+4 SET IBDLEXV=1
+5 IF $DATA(^LEX)>1
SET X="LEXSET"
XECUTE ^%ZOSF("TEST")
IF $TEST
SET IBDLEXV=2
+6 IF IBDLEXV=1
Begin DoDot:1
+7 IF $GET(X)=""
KILL X
SET Y=""
QUIT
+8 IF '$DATA(^GMP(757.01,+X,0))
KILL X
SET Y=""
QUIT
+9 SET VAL=$$ICDONE^GMPTU(X)
+10 IF VAL=""
KILL X
SET Y="No ICD"_$SELECT(DT'<IBDIMP:"10",1:"9")_" code"
QUIT
+11 IF VAL=IBDIBX
KILL X
SET Y="ICD"_$SELECT(DT'<IBDIMP:"10",1:"9")_" code "_IBDIBX
QUIT
+12 IF $GET(X)=""
KILL X
SET Y=""
QUIT
+13 QUIT
End DoDot:1
+14 IF IBDLEXV>1
Begin DoDot:1
+15 IF $GET(X)=""
KILL X
SET Y=""
QUIT
+16 IF '$DATA(^LEX(757.01,+X,0))
KILL X
SET Y=""
QUIT
+17 SET VAL=$$ICDONE^LEXU(X)
+18 IF VAL=""
KILL X
SET Y="No ICD"_$SELECT(DT'<IBDIMP:"10",1:"9")_" code"
QUIT
+19 IF VAL=IBDIBX
KILL X
SET Y="ICD"_$SELECT(DT'<IBDIMP:"10",1:"9")_" code "_IBDIBX
QUIT
+20 QUIT
End DoDot:1
+21 QUIT
