- 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 Feb 19, 2025@00:19:25 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