| [613] | 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
 | 
|---|