source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFN7.m@ 738

Last change on this file since 738 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1IBDFN7 ;ALB/CJM - ENCOUNTER FORM - validate logic for data ;MAY 10,1995
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**38,51**;APR 24, 1997
3 ;
4TESTCPT ;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 ;
16TESTICD ; -- 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 ;
29TESTVST ;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 ;
42TESTLEX ; -- 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
Note: See TracBrowser for help on using the repository browser.