- 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
