source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMVALC.m@ 794

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

initial load of FOIAVistA 6/30/08 version
File size: 8.7 KB
Line 
1PXRMVALC ; SLC/KR - VAL Validate Codes (format/value) ;08/15/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 Q
4 ;
5 ; Entry points (extrinsic functions)
6 ;
7 ; ICD^PXRMVALC(<code>) Validate ICD-9-CM Diagnosis Code
8 ; ICP^PXRMVALC(<code>) Validate ICD-9-CM Procedure Code
9 ; CPT^PXRMVALC(<code>) Validate CPT-4 Procedure Code
10 ;
11 ; All entry points return:
12 ;
13 ; <validity>^<input>^<output>^<error>^<file #>^<global root>^
14 ; <type of code>^<input IEN>^<input flag>^<output IEN>^
15 ; <output flag>^<description>
16 ;
17ICD(X) ; Validate ICD-9-CM Diagnosis Code from file 80
18 S X=$G(X),U="^" N CHR,CHKD,CIN,CODE,COUT,DIC,ERR,ES,FNUM,FORM,IENI,IENO,IFIN,IFOUT,NAME,NUMERIC,PAT,TY,VAL,Y
19 S VAL=1,FNUM=80,DIC="ICD9(",(IFIN,IFOUT,NAME)="",CIN=$TR(X,"""",""),U="^"
20 S FORM=$S($E(X,1)="E":2,$E(X,1)="V":3,$E(X,1)?1N:1,1:1),TY=$S(FORM=2:"ICD ""E"" code",FORM=3:"ICD ""V"" code",FORM=1:"ICD code",1:"ICD code")
21 S ERR="Valid "_TY,CHKD=$S(FORM=2:"ICD-9-CM ""E"" external cause code",FORM=3:"ICD-9-CM ""V"" health factor code",FORM=1:"ICD-9-CM diagnosis code",1:"ICD-9-CM code")
22 S PAT=$S(FORM=2:"ENNN.nn",FORM=3:"VNN.nn",FORM=1:"NNN.nn",1:"ENNN.nn, VNN.nn or NNN.nn")
23 ; Code transformation
24 S CODE=X S:CODE'["." CODE=CODE_"."
25 S:FORM=1&($L($P(CODE,".",1))=1)&(+($P(CODE,".",1))>0) $P(CODE,".",1)="00"_$P(CODE,".",1) S:FORM=1&($L($P(CODE,".",1))=2)&(+($P(CODE,".",1))>0) $P(CODE,".",1)="0"_$P(CODE,".",1) S X=CODE
26 S CODE=$P(CODE,".",1,2),CODE=$$NEXT^ICDAPIU(CODE),COUT=CODE,(IENI,IENO)=""
27 I +$$CODEN^ICDCODE(COUT,80)>0 D
28 .N ICD9,IFOUTX
29 .S IENO=+$$CODEN^ICDCODE(COUT,80)
30 .S ICD9=$$ICDDX^ICDCODE(+IENO)
31 .S NAME=$P(ICD9,U,4)
32 .S IFOUTX=$P(ICD9,U,10),IFOUT=$S(IFOUTX=0:1,IFOUTX=1:0,1:"")
33 S ES="Invalid "_TY_" format "
34 ; Format
35 ; not enough digits
36 I $E(CIN,1)="E",$L($P($E(CIN,2,$L(CIN)),".",1))<3 D ERR((ES_"(not enough digits, "_PAT_")")) G AQ
37 I $E(CIN,1)?1N,$L($P(CIN,".",1))<3 D ERR((ES_"(not enough digits, "_PAT_")")) G AQ
38 I $E(CIN,1)="V",$L($P($E(CIN,2,$L(CIN)),".",1))<2 D ERR((ES_"(not enough digits, "_PAT_")")) G AQ
39 ; too many digits
40 I $E(CIN,1)="E",$L($P($E(CIN,2,$L(CIN)),".",1))>3 D ERR((ES_"(too many digits, "_PAT_")")) G AQ
41 I $E(CIN,1)?1N,$L($P(CIN,".",1))>3 D ERR((ES_"(too many digits, "_PAT_")")) G AQ
42 I $E(CIN,1)="V",$L($P($E(CIN,2,$L(CIN)),".",1))>2 D ERR((ES_"(too many digits, "_PAT_")")) G AQ
43 ; missing decimal point
44 I CIN'["." D ERR((ES_"(missing decimal point "_PAT_")")) G AQ
45 ; to many decimal points
46 I $L(CIN,".")>2 D ERR((ES_"(too many decimal points "_PAT_")")) G AQ
47 ; to many decimal places
48 I $L($P(CIN,".",2))>2 D ERR((ES_"(too many decimals places, "_PAT_")")) G AQ
49 ; non-numeric decimal
50 I $P(CIN,".",2)'?2N&($P(CIN,".",2)'?1N)&($P(CIN,".",2)'="") D ERR((ES_"(non-numeric decimal, "_PAT_")")) G AQ
51 ; invalid pattern
52 I $E(CIN,1)="E",$P(CIN,".",1)'?1U3N D ERR((ES_"("_PAT_")")) G AQ
53 I $E(CIN,1)="V",$P(CIN,".",1)'?1U2N D ERR((ES_"("_PAT_")")) G AQ
54 I $E(CIN,1)?1N,$P(CIN,".",1)'?3N D ERR((ES_"("_PAT_")")) G AQ
55 ; Value
56 ; not found
57 I +$$CODEN^ICDCODE(CIN,80)<0 D G AQ
58 . N TC D ERR((TY_" not found in the ICD-9 file (#80)"))
59 . S TC=COUT S:'$L(TC) TC=CIN I $E(TC,$L(TC))="0" D
60 . . N SC,COUT S (SC,COUT)=TC F S TC=$E(TC,1,($L(TC)-1)) S:+$$CODEN^ICDCODE(TC,80)>0 SC=TC Q:$E(TC,$L(TC))'="0"!(SC'=COUT) Q:TC=""
61 . . S TC="" S:SC'=COUT TC=SC
62 . S:$L(TC) COUT=TC
63 . S:+$$CODEN^ICDCODE(CIN_"0")>0 COUT=CIN_"0"
64 . I +$$CODEN^ICDCODE(COUT,80)>0 D
65 . . N ICD9,IFOUTX
66 . . S IENO=+$$CODEN^ICDCODE(COUT,80)
67 . . S ICD9=$$ICDDX^ICDCODE(+IENO)
68 . . S NAME=$P(ICD9,U,4)
69 . . S IFOUTX=$P(ICD9,U,10),IFOUT=$S(IFOUTX=0:1,IFOUTX=1:0,1:"")
70 ; found
71 I $$CODEN^ICDCODE(CIN,80)>0 D G AQ
72 . D ERR(("Valid "_TY)) S VAL=1
73 . S IENI=+$$CODEN^ICDCODE(CIN,80)
74 . N ICD9,IFINX
75 . S ICD9=$$ICDDX^ICDCODE(IENI)
76 . S NAME=$P(ICD9,U,4)
77 . S IFINX=$P(ICD9,U,10),IFIN=$S(IFINX=0:1,IFINX=1:0,1:"")
78 . S:(+(IFOUT)+(IFIN))>0 ERR="Inactive "_TY
79 G AQ
80 ;
81ICP(X) ; Validate ICD-9-CM Procedure Code from file 80.1
82 S X=$G(X),U="^" N CHR,CHKD,CIN,CODE,COUT,DIC,ERR,ES,FNUM,FORM,IENI,IENO,IFIN,IFOUT,NAME,NUMERIC,PAT,TY,VAL,Y
83 S FNUM=80.1,DIC="ICD0(",VAL=1,(NAME,IFIN,IFOUT)="",CIN=$TR(X,"""","")
84 ; Code transformation
85 S CODE=X,TY="ICD Procedure code",PAT="NN.nn",CHKD=TY S:CODE'["." CODE=CODE_"." S:$L($P(CODE,".",1))=1 CODE="0"_CODE S CODE=$$NEXT^ICDAPIU(CODE),COUT=CODE
86 S VAL=1,ERR="Valid "_TY
87 I +$$CODEN^ICDCODE(CODE,80.1)>0 D
88 .S IENO=+$$CODEN^ICDCODE(CODE,80.1)
89 .N ICDO,IFOUTX
90 .S ICDO=$$ICDOP^ICDCODE(+IENO)
91 .S NAME=$P(ICDO,"^",5)
92 .S IFOUTX=$P(ICDO,U,10),IFOUT=$S(IFOUTX=0:1,IFOUTX=1:"",1:"")
93 S ES="Invalid "_TY_" format "
94 ; Format
95 ; not enough digits
96 I $L($P(CIN,".",1))<2 D ERR((ES_"(not enough digits, "_PAT_")")) G AQ
97 ; too many digits
98 I $L($P(CIN,".",1))>2 D ERR((ES_"(too many digits, "_PAT_")")) G AQ
99 ; missing decimal point
100 I CIN'["." D ERR((ES_"(missing decimal point "_PAT_")")) G AQ
101 ; too many decimal points
102 I $L(CIN,".")>2 D ERR((ES_"(too many decimal points "_PAT_")")) G AQ
103 ; too many decimal places
104 I $L($P(CIN,".",2))>2 D ERR((ES_"(too many decimals places, "_PAT_")")) G AQ
105 ; non-numeric decimal
106 I $P(CIN,".",2)'?2N&($P(CIN,".",2)'?1N)&($P(CIN,".",2)'="") D ERR((ES_"(non-numeric decimal, "_PAT_")")) G AQ
107 ; invalid pattern
108 I $P(CIN,".",1)'?2N D ERR((ES_"("_PAT_")")) G AQ
109 ; Value
110 ; not found
111 I +$$CODEN^ICDCODE(CIN,80.1)<0 D G AQ
112 . N TC D ERR((TY_" not found in the ICD-0 file (#80.1)")) S COUT=""
113 . S TC=COUT S:'$L(TC) TC=CIN I $E(TC,$L(TC))="0" D
114 . . N SC,COUT S (SC,COUT)=TC F S TC=$E(TC,1,($L(TC)-1)) S:+$$CODEN^ICDCODE(TC,80.1)>0 SC=TC Q:$E(TC,$L(TC))'="0"!(SC'=COUT) Q:TC=""
115 . . S TC="" S:SC'=COUT TC=SC
116 . S:$L(TC) COUT=TC
117 . S:+$$CODEN^ICDCODE(CIN_"0",80.1)>0 COUT=CIN_"0"
118 . I +$$CODEN^ICDCODE(COUT,80.1)>0 D
119 . . S IENO=+$$CODEN^ICDCODE(COUT,80.1)
120 . . N ICDO,IFOUTX
121 . . S ICDO=$$ICDOP^ICDCODE(+IENO)
122 . . S NAME=$P(ICDO,"^",5)
123 . . S IFOUTX=$P(ICDO,U,10),IFOUT=$S(IFOUTX=0:1,IFOUTX=1:"",1:"")
124 ; found
125 I $$CODEN^ICDCODE(CIN,80.1)>0 D G AQ
126 . S VAL=1,ERR="Valid "_TY
127 . S IENI=+$$CODEN^ICDCODE(CIN,80.1)
128 . N ICDO,IFINX
129 . S ICDO=$$ICDOP^ICDCODE(+IENI)
130 . S NAME=$P(ICDO,"^",5)
131 . S IFINX=$P(ICDO,"^",10),IFIN=$S(IFINX=0:1,IFINX=1:"",1:"")
132 . S:(+(IFOUT)+(IFIN))>0 ERR="Inactive "_TY
133 G AQ
134 ;
135CPT(X) ; Validate Procedure Code from file 81
136 S X=$G(X),U="^"
137 N CHR,CHKD,CIN,CODE,COUT,DIC,ERR,ES,FNUM,FORM,IENI,IENO,IFIN,IFOUT
138 N NAME,NUMERIC,PAT,STATUS,TEMP,TY,VAL,Y
139 S VAL=1,FNUM=81,DIC="ICPT(",(IFIN,IFOUT,NAME)="",CIN=$TR(X,"""","")
140 S FORM=$S(CIN?5N:1,CIN?1A4N:2,CIN?4N1A:2,1:0)
141 S TY=$S(FORM=1:"CPT-4 code",FORM=2:"HCPCS code",1:"unknown")
142 S CHKD=$S(FORM=1:"CPT-4 procedure code",FORM=2:"HCPCS procedure code",1:"Unknown format")
143 S PAT=$S(FORM=1:"NNNNN",FORM=2:"ANNNN or NNNNA",1:"")
144 S ES="Invalid "_TY_" format "
145 ; Code transformation
146 ; HCPCS
147 S CODE=X I FORM=2 D
148 . N CHR,NUMERIC S CHR=$E(CODE,1),NUMERIC=$E(CODE,2,$L(CODE))
149 . S NUMERIC=$TR(NUMERIC,"~!@#$%^&*()_-+=[{]};:\|,./?<>QWERTYUIOPASDFGHJKLZXCVBNMqwertyuiopasdfghjklzxcvbnm","0000000000000000000000000000000000000000000000000000000000000000000000000000000000")
150 . F Q:$E(NUMERIC,1)'="0" S NUMERIC=$E(NUMERIC,2,$L(NUMERIC))
151 . S NUMERIC=+NUMERIC F Q:$L(NUMERIC)>3 S NUMERIC="0"_NUMERIC
152 . S CODE=CHR_NUMERIC
153 ; CPT-4
154 I FORM=1 D
155 . N NUMERIC S NUMERIC=CODE,NUMERIC=$TR(NUMERIC,"~!@#$%^&*()_-+=[{]};:\|,./?<>QWERTYUIOPASDFGHJKLZXCVBNMqwertyuiopasdfghjklzxcvbnm","0000000000000000000000000000000000000000000000000000000000000000000000000000000000")
156 . I +NUMERIC>0,$E(NUMERIC,1)'="0",$L(NUMERIC)<5 F Q:$L(NUMERIC)=5 S NUMERIC="0"_NUMERIC
157 . I +NUMERIC>0,$E(NUMERIC,1)="0",$L(NUMERIC)<5 F Q:$L(NUMERIC)=5 S NUMERIC=NUMERIC_"0"
158 . F Q:$E(NUMERIC,1)'="0" S NUMERIC=$E(NUMERIC,2,$L(NUMERIC))
159 . S NUMERIC=+NUMERIC F Q:$L(NUMERIC)>4 S NUMERIC="0"_NUMERIC
160 . S CODE=NUMERIC
161 S CODE=$$NEXT^ICPTAPIU(CODE),COUT=CODE S (IENI,IENO)=""
162 I $L(COUT),+$$CODEN^ICPTCOD(COUT)>0 D
163 . S IENO=+$$CODEN^ICPTCOD(COUT)
164 . S TEMP=$$CPT^ICPTCOD(IENO)
165 . S NAME=$P(TEMP,U,3)
166 . S STATUS=$P(TEMP,U,7)
167 . S IFOUT=$S(STATUS:"",1:1)
168 ; Format
169 ; not enough characters
170 I $L(CIN)<5 D ERR((ES_"(not enough characters)")) G AQ
171 ; too many characters
172 I $L(CIN)>5 D ERR((ES_"(too many characters)")) G AQ
173 ; Invalid pattern
174 I FORM=0 D ERR(ES_PAT) G AQ
175 ; Value not found
176 I +$$CODEN^ICPTCOD(CIN)<1 D ERR((TY_" not found in the CPT file (#81)")) S COUT="" G AQ
177 ; found
178 I +$$CODEN^ICPTCOD(CIN)>0 D G AQ
179 . S VAL=1,ERR="Valid "_TY
180 . S IENI=+$$CODEN^ICPTCOD(CIN)
181 . S TEMP=$$CPT^ICPTCOD(IENI)
182 . S NAME=$P(TEMP,U,3)
183 . S STATUS=$P(TEMP,U,7)
184 . S IFIN=$S(STATUS:"",1:1)
185 . S:(+(IFOUT)+(IFIN))>0 ERR="Inactive "_TY
186 G AQ
187AQ ; Assemble output string and quit
188 S X=$G(VAL)_U_$G(CIN)_U_$G(COUT)_U_$G(ERR)_U_FNUM
189 S X=X_U_DIC_U_$G(CHKD)_U_$G(IENI)_U_$G(IFIN)_U_$G(IENO)_U_$G(IFOUT)_U_$G(NAME)
190 F Q:$E(X,$L(X))'="^" S X=$E(X,1,($L(X)-1))
191 Q X
192ERR(X) S VAL=0,ERR=$G(X) Q
Note: See TracBrowser for help on using the repository browser.