IBDFN7 ;ALB/CJM - ENCOUNTER FORM - validate logic for data ;MAY 10,1995
;;3.0;AUTOMATED INFO COLLECTION SYS;**38**;APR 24, 1997
;
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 ICD9 code? Kills X if not.
; -- input the icd code in X
;
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
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
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 ICD9 code" Q
.I VAL=799.9 K X S Y="ICD9 code 799.9" 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 ICD9 code" Q
.I VAL=799.9 K X S Y="ICD9 code 799.9" Q
.Q
Q
IBDFN7 ;ALB/CJM - ENCOUNTER FORM - validate logic for data ;MAY 10,1995
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**38**;APR 24, 1997
+2 ;
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 ICD9 code? Kills X if not.
+1 ; -- input the icd code in X
+2 ;
+3 IF $GET(X)=""
KILL X
SET Y=""
QUIT
+4 ; use ba xref, add space to end for lookup.
IF $EXTRACT(X,$LENGTH(X))'=" "
SET X=X_" "
+5 SET X=$ORDER(^ICD9("BA",X,0))
IF 'X
KILL X
SET Y=""
QUIT
+6 IF '$DATA(^ICD9(X,0))
KILL X
SET Y=""
QUIT
+7 IF $PIECE($GET(^ICD9(X,0)),"^",9)
SET Y=$PIECE(^ICD9(X,0),"^",3)
KILL X
+8 QUIT
+9 ;
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 SET IBDLEXV=1
+2 IF $DATA(^LEX)>1
SET X="LEXSET"
XECUTE ^%ZOSF("TEST")
IF $TEST
SET IBDLEXV=2
+3 IF IBDLEXV=1
Begin DoDot:1
+4 IF $GET(X)=""
KILL X
SET Y=""
QUIT
+5 IF '$DATA(^GMP(757.01,+X,0))
KILL X
SET Y=""
QUIT
+6 SET VAL=$$ICDONE^GMPTU(X)
+7 IF VAL=""
KILL X
SET Y="No ICD9 code"
QUIT
+8 IF VAL=799.9
KILL X
SET Y="ICD9 code 799.9"
QUIT
+9 IF $GET(X)=""
KILL X
SET Y=""
QUIT
+10 QUIT
End DoDot:1
+11 IF IBDLEXV>1
Begin DoDot:1
+12 IF $GET(X)=""
KILL X
SET Y=""
QUIT
+13 IF '$DATA(^LEX(757.01,+X,0))
KILL X
SET Y=""
QUIT
+14 SET VAL=$$ICDONE^LEXU(X)
+15 IF VAL=""
KILL X
SET Y="No ICD9 code"
QUIT
+16 IF VAL=799.9
KILL X
SET Y="ICD9 code 799.9"
QUIT
+17 QUIT
End DoDot:1
+18 QUIT
