| 1 | IBDFN7 ;ALB/CJM - ENCOUNTER FORM - validate logic for data ;MAY 10,1995
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;**38,51**;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | TESTCPT ;does X point to a valid CPT4 code? Kills X if not.
|
|---|
| 5 | ;
|
|---|
| 6 | ;;change to api cpt;dhh
|
|---|
| 7 | N XX
|
|---|
| 8 | S Y=""
|
|---|
| 9 | I $G(X)="" K X Q
|
|---|
| 10 | S XX=$$CPT^ICPTCOD($G(X))
|
|---|
| 11 | I +XX=-1 K X Q
|
|---|
| 12 | I $P(XX,U,7)'=1 K X S Y=$P(XX,U,3) Q
|
|---|
| 13 | S X=$P(XX,U) ;set X equal ien of cpt code
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | TESTICD ; -- does X point to a valid ICD9 code? Kills X if not.
|
|---|
| 17 | ; -- input the icd code in X
|
|---|
| 18 | ;
|
|---|
| 19 | N CODE,STATUS
|
|---|
| 20 | I $G(X)="" K X S Y="" Q
|
|---|
| 21 | S:$E(X,$L(X))'=" " X=X_" " ; use ba xref, add space to end for lookup.
|
|---|
| 22 | S X=$O(^ICD9("BA",X,0)) I 'X K X S Y="" Q
|
|---|
| 23 | I '$D(^ICD9(X,0)) K X S Y="" Q
|
|---|
| 24 | ;;I $P($G(^ICD9(X,0)),"^",9) S Y=$P(^ICD9(X,0),"^",3) K X
|
|---|
| 25 | S CODE=$$ICDDX^ICDCODE(X)
|
|---|
| 26 | S STATUS=$P(CODE,U,10) I STATUS'=1 S Y=$P(CODE,U,4) K X
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | TESTVST ;does X point to a valid visit code? If not, kills X.
|
|---|
| 30 | ;checks that X is a valid CPT4 code and that there is a corresponding entry in the TYPE OF VISIT file that is active
|
|---|
| 31 | N IEN,XX
|
|---|
| 32 | I $G(X)="" K X S Y="" Q
|
|---|
| 33 | ;;change to api cpt;dhh
|
|---|
| 34 | S XX=$$CPT^ICPTCOD(X)
|
|---|
| 35 | I +XX=-1 K X S Y="" Q
|
|---|
| 36 | I $P(XX,U,7)'=1 K X S Y=$P(XX,U,3) Q
|
|---|
| 37 | S X=$P(XX,U) ;set X equal ien of cpt code
|
|---|
| 38 | Q:'$D(X)
|
|---|
| 39 | S IEN=$O(^IBE(357.69,"B",X,0)) K:'IEN X I IEN K:$P($G(^IBE(357.69,IEN,0)),"^",4) X
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | TESTLEX ; -- Is clinical lexicon pointer valid and does icdone, not return 799.9
|
|---|
| 43 | S IBDLEXV=1
|
|---|
| 44 | I $D(^LEX)>1 S X="LEXSET" X ^%ZOSF("TEST") I $T S IBDLEXV=2
|
|---|
| 45 | I IBDLEXV=1 D
|
|---|
| 46 | .I $G(X)="" K X S Y="" Q
|
|---|
| 47 | .I '$D(^GMP(757.01,+X,0)) K X S Y="" Q
|
|---|
| 48 | .S VAL=$$ICDONE^GMPTU(X)
|
|---|
| 49 | .I VAL="" K X S Y="No ICD9 code" Q
|
|---|
| 50 | .I VAL=799.9 K X S Y="ICD9 code 799.9" Q
|
|---|
| 51 | .I $G(X)="" K X S Y="" Q
|
|---|
| 52 | .Q
|
|---|
| 53 | I IBDLEXV>1 D
|
|---|
| 54 | .I $G(X)="" K X S Y="" Q
|
|---|
| 55 | .I '$D(^LEX(757.01,+X,0)) K X S Y="" Q
|
|---|
| 56 | .S VAL=$$ICDONE^LEXU(X)
|
|---|
| 57 | .I VAL="" K X S Y="No ICD9 code" Q
|
|---|
| 58 | .I VAL=799.9 K X S Y="ICD9 code 799.9" Q
|
|---|
| 59 | .Q
|
|---|
| 60 | Q
|
|---|
