Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMVALC

PXRMVALC.m

Go to the documentation of this file. 
  1. PXRMVALC ; SLC/KR - VAL Validate Codes (format/value)    ;31-May-2013 13:35;DU
  1.  ;;2.0;CLINICAL REMINDERS;**4,1001**;Feb 04, 2005;Build 21
  1.  Q
  1.  ;
  1.  ; Entry points (extrinsic functions)
  1.  ;
  1.  ;     ICD^PXRMVALC(<code>)   Validate ICD-9-CM Diagnosis Code
  1.  ;     ICP^PXRMVALC(<code>)   Validate ICD-9-CM Procedure Code
  1.  ;     CPT^PXRMVALC(<code>)   Validate CPT-4 Procedure Code
  1.  ;
  1.  ;  All entry points return:
  1.  ;
  1.  ;    <validity>^<input>^<output>^<error>^<file #>^<global root>^
  1.  ;    <type of code>^<input IEN>^<input flag>^<output IEN>^
  1.  ;    <output flag>^<description>
  1.  ;
  1. ICD(X) ; Validate ICD-9-CM Diagnosis Code from file 80
  1.  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
  1.  S VAL=1,FNUM=80,DIC="ICD9(",(IFIN,IFOUT,NAME)="",CIN=$TR(X,"""",""),U="^"
  1.  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")
  1.  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")
  1.  S PAT=$S(FORM=2:"ENNN.nn",FORM=3:"VNN.nn",FORM=1:"NNN.nn",1:"ENNN.nn, VNN.nn or NNN.nn")
  1.  ; Code transformation
  1.  S CODE=X S:CODE'["." CODE=CODE_"."
  1.  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
  1.  S CODE=$P(CODE,".",1,2),CODE=$$NEXT^ICDAPIU(CODE),COUT=CODE,(IENI,IENO)=""
  1.  I +$$CODEN^ICDCODE(COUT,80)>0 D
  1.  .N ICD9,IFOUTX
  1.  .S IENO=+$$CODEN^ICDCODE(COUT,80)
  1.  .S ICD9=$$ICDDX^ICDCODE(+IENO)
  1.  .S NAME=$P(ICD9,U,4)
  1.  .S IFOUTX=$P(ICD9,U,10),IFOUT=$S(IFOUTX=0:1,IFOUTX=1:0,1:"")
  1.  S ES="Invalid "_TY_" format "
  1.  ; Format
  1.  ;    not enough digits
  1.  I $E(CIN,1)="E",$L($P($E(CIN,2,$L(CIN)),".",1))<3 D ERR((ES_"(not enough digits, "_PAT_")")) G AQ
  1.  I $E(CIN,1)?1N,$L($P(CIN,".",1))<3 D ERR((ES_"(not enough digits, "_PAT_")")) G AQ
  1.  I $E(CIN,1)="V",$L($P($E(CIN,2,$L(CIN)),".",1))<2 D ERR((ES_"(not enough digits, "_PAT_")")) G AQ
  1.  ;    too many digits
  1.  I $E(CIN,1)="E",$L($P($E(CIN,2,$L(CIN)),".",1))>3 D ERR((ES_"(too many digits, "_PAT_")")) G AQ
  1.  I $E(CIN,1)?1N,$L($P(CIN,".",1))>3 D ERR((ES_"(too many digits, "_PAT_")")) G AQ
  1.  I $E(CIN,1)="V",$L($P($E(CIN,2,$L(CIN)),".",1))>2 D ERR((ES_"(too many digits, "_PAT_")")) G AQ
  1.  ;    missing decimal point
  1.  I CIN'["." D ERR((ES_"(missing decimal point "_PAT_")")) G AQ
  1.  ;    to many decimal points
  1.  I $L(CIN,".")>2 D ERR((ES_"(too many decimal points "_PAT_")")) G AQ
  1.  ;    to many decimal places
  1.  I $L($P(CIN,".",2))>2 D ERR((ES_"(too many decimals places, "_PAT_")")) G AQ
  1.  ;    non-numeric decimal
  1.  I $P(CIN,".",2)'?2N&($P(CIN,".",2)'?1N)&($P(CIN,".",2)'="") D ERR((ES_"(non-numeric decimal, "_PAT_")")) G AQ
  1.  ;    invalid pattern
  1.  I $E(CIN,1)="E",$P(CIN,".",1)'?1U3N D ERR((ES_"("_PAT_")")) G AQ
  1.  I $E(CIN,1)="V",$P(CIN,".",1)'?1U2N D ERR((ES_"("_PAT_")")) G AQ
  1.  I $E(CIN,1)?1N,$P(CIN,".",1)'?3N D ERR((ES_"("_PAT_")")) G AQ
  1.  ; Value
  1.  ;    not found
  1.  I +$$CODEN^ICDCODE(CIN,80)<0 D  G AQ
  1.  . N TC D ERR((TY_" not found in the ICD-9 file (#80)"))
  1.  . S TC=COUT S:'$L(TC) TC=CIN I $E(TC,$L(TC))="0" D
  1.  . . 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=""
  1.  . . S TC="" S:SC'=COUT TC=SC
  1.  . S:$L(TC) COUT=TC
  1.  . S:+$$CODEN^ICDCODE(CIN_"0")>0 COUT=CIN_"0"
  1.  . I +$$CODEN^ICDCODE(COUT,80)>0 D
  1.  . . N ICD9,IFOUTX
  1.  . . S IENO=+$$CODEN^ICDCODE(COUT,80)
  1.  . . S ICD9=$$ICDDX^ICDCODE(+IENO)
  1.  . . S NAME=$P(ICD9,U,4)
  1.  . . S IFOUTX=$P(ICD9,U,10),IFOUT=$S(IFOUTX=0:1,IFOUTX=1:0,1:"")
  1.  ;    found
  1.  I $$CODEN^ICDCODE(CIN,80)>0 D  G AQ
  1.  . D ERR(("Valid "_TY)) S VAL=1
  1.  . S IENI=+$$CODEN^ICDCODE(CIN,80)
  1.  . N ICD9,IFINX
  1.  . S ICD9=$$ICDDX^ICDCODE(IENI)
  1.  . S NAME=$P(ICD9,U,4)
  1.  . S IFINX=$P(ICD9,U,10),IFIN=$S(IFINX=0:1,IFINX=1:0,1:"")
  1.  . S:(+(IFOUT)+(IFIN))>0 ERR="Inactive "_TY
  1.  G AQ
  1.  ;
  1. ICP(X) ; Validate ICD-9-CM Procedure Code from file 80.1
  1.  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
  1.  S FNUM=80.1,DIC="ICD0(",VAL=1,(NAME,IFIN,IFOUT)="",CIN=$TR(X,"""","")
  1.  ; Code transformation
  1.  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
  1.  S VAL=1,ERR="Valid "_TY
  1.  I +$$CODEN^ICDCODE(CODE,80.1)>0 D
  1.  .S IENO=+$$CODEN^ICDCODE(CODE,80.1)
  1.  .N ICDO,IFOUTX
  1.  .S ICDO=$$ICDOP^ICDCODE(+IENO)
  1.  .S NAME=$P(ICDO,"^",5)
  1.  .S IFOUTX=$P(ICDO,U,10),IFOUT=$S(IFOUTX=0:1,IFOUTX=1:"",1:"")
  1.  S ES="Invalid "_TY_" format "
  1.  ; Format
  1.  ;    not enough digits
  1.  I $L($P(CIN,".",1))<2 D ERR((ES_"(not enough digits, "_PAT_")")) G AQ
  1.  ;    too many digits
  1.  I $L($P(CIN,".",1))>2 D ERR((ES_"(too many digits, "_PAT_")")) G AQ
  1.  ;    missing decimal point
  1.  I CIN'["." D ERR((ES_"(missing decimal point "_PAT_")")) G AQ
  1.  ;    too many decimal points
  1.  I $L(CIN,".")>2 D ERR((ES_"(too many decimal points "_PAT_")")) G AQ
  1.  ;    too many decimal places
  1.  I $L($P(CIN,".",2))>2 D ERR((ES_"(too many decimals places, "_PAT_")")) G AQ
  1.  ;    non-numeric decimal
  1.  I $P(CIN,".",2)'?2N&($P(CIN,".",2)'?1N)&($P(CIN,".",2)'="") D ERR((ES_"(non-numeric decimal, "_PAT_")")) G AQ
  1.  ;    invalid pattern
  1.  I $P(CIN,".",1)'?2N D ERR((ES_"("_PAT_")")) G AQ
  1.  ; Value
  1.  ;    not found
  1.  I +$$CODEN^ICDCODE(CIN,80.1)<0 D  G AQ
  1.  . N TC D ERR((TY_" not found in the ICD-0 file (#80.1)")) S COUT=""
  1.  . S TC=COUT S:'$L(TC) TC=CIN I $E(TC,$L(TC))="0" D
  1.  . . 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=""
  1.  . . S TC="" S:SC'=COUT TC=SC
  1.  . S:$L(TC) COUT=TC
  1.  . S:+$$CODEN^ICDCODE(CIN_"0",80.1)>0 COUT=CIN_"0"
  1.  . I +$$CODEN^ICDCODE(COUT,80.1)>0 D
  1.  . . S IENO=+$$CODEN^ICDCODE(COUT,80.1)
  1.  . . N ICDO,IFOUTX
  1.  . . S ICDO=$$ICDOP^ICDCODE(+IENO)
  1.  . . S NAME=$P(ICDO,"^",5)
  1.  . . S IFOUTX=$P(ICDO,U,10),IFOUT=$S(IFOUTX=0:1,IFOUTX=1:"",1:"")
  1.  ;    found
  1.  I $$CODEN^ICDCODE(CIN,80.1)>0 D  G AQ
  1.  . S VAL=1,ERR="Valid "_TY
  1.  . S IENI=+$$CODEN^ICDCODE(CIN,80.1)
  1.  . N ICDO,IFINX
  1.  . S ICDO=$$ICDOP^ICDCODE(+IENI)
  1.  . S NAME=$P(ICDO,"^",5)
  1.  . S IFINX=$P(ICDO,"^",10),IFIN=$S(IFINX=0:1,IFINX=1:"",1:"")
  1.  . S:(+(IFOUT)+(IFIN))>0 ERR="Inactive "_TY
  1.  G AQ
  1.  ;
  1. CPT(X) ; Validate Procedure Code from file 81
  1.  S X=$G(X),U="^"
  1.  N CHR,CHKD,CIN,CODE,COUT,DIC,ERR,ES,FNUM,FORM,IENI,IENO,IFIN,IFOUT
  1.  N NAME,NUMERIC,PAT,STATUS,TEMP,TY,VAL,Y
  1.  S VAL=1,FNUM=81,DIC="ICPT(",(IFIN,IFOUT,NAME)="",CIN=$TR(X,"""","")
  1.  S FORM=$S(CIN?5N:1,CIN?1A4N:2,CIN?4N1A:2,1:0)
  1.  S TY=$S(FORM=1:"CPT-4 code",FORM=2:"HCPCS code",1:"unknown")
  1.  S CHKD=$S(FORM=1:"CPT-4 procedure code",FORM=2:"HCPCS procedure code",1:"Unknown format")
  1.  S PAT=$S(FORM=1:"NNNNN",FORM=2:"ANNNN or NNNNA",1:"")
  1.  S ES="Invalid "_TY_" format "
  1.  ; Code transformation
  1.  ;    HCPCS
  1.  S CODE=X I FORM=2 D
  1.  . N CHR,NUMERIC S CHR=$E(CODE,1),NUMERIC=$E(CODE,2,$L(CODE))
  1.  . S NUMERIC=$TR(NUMERIC,"~!@#$%^&*()_-+=[{]};:\|,./?<>QWERTYUIOPASDFGHJKLZXCVBNMqwertyuiopasdfghjklzxcvbnm","0000000000000000000000000000000000000000000000000000000000000000000000000000000000")
  1.  . F  Q:$E(NUMERIC,1)'="0"  S NUMERIC=$E(NUMERIC,2,$L(NUMERIC))
  1.  . S NUMERIC=+NUMERIC F  Q:$L(NUMERIC)>3  S NUMERIC="0"_NUMERIC
  1.  . S CODE=CHR_NUMERIC
  1.  ;    CPT-4
  1.  I FORM=1 D
  1.  . N NUMERIC S NUMERIC=CODE,NUMERIC=$TR(NUMERIC,"~!@#$%^&*()_-+=[{]};:\|,./?<>QWERTYUIOPASDFGHJKLZXCVBNMqwertyuiopasdfghjklzxcvbnm","0000000000000000000000000000000000000000000000000000000000000000000000000000000000")
  1.  . I +NUMERIC>0,$E(NUMERIC,1)'="0",$L(NUMERIC)<5 F  Q:$L(NUMERIC)=5  S NUMERIC="0"_NUMERIC
  1.  . I +NUMERIC>0,$E(NUMERIC,1)="0",$L(NUMERIC)<5 F  Q:$L(NUMERIC)=5  S NUMERIC=NUMERIC_"0"
  1.  . F  Q:$E(NUMERIC,1)'="0"  S NUMERIC=$E(NUMERIC,2,$L(NUMERIC))
  1.  . S NUMERIC=+NUMERIC F  Q:$L(NUMERIC)>4  S NUMERIC="0"_NUMERIC
  1.  . S CODE=NUMERIC
  1.  ;S CODE=$$NEXT^ICPTAPIU(CODE),COUT=CODE S (IENI,IENO)=""   ;Patch 1001
  1.  S CODE=$$NEXT^PXRMVALU(CODE),COUT=CODE S (IENI,IENO)=""    ;Patch 1001 replaced call
  1.  I $L(COUT),+$$CODEN^ICPTCOD(COUT)>0 D
  1.  . S IENO=+$$CODEN^ICPTCOD(COUT)
  1.  . S TEMP=$$CPT^ICPTCOD(IENO)
  1.  . S NAME=$P(TEMP,U,3)
  1.  . S STATUS=$P(TEMP,U,7)
  1.  . S IFOUT=$S(STATUS:"",1:1)
  1.  ; Format
  1.  ;    not enough characters
  1.  I $L(CIN)<5 D ERR((ES_"(not enough characters)")) G AQ
  1.  ;    too many characters
  1.  I $L(CIN)>5 D ERR((ES_"(too many characters)")) G AQ
  1.  ; Invalid pattern
  1.  I FORM=0 D ERR(ES_PAT) G AQ
  1.  ; Value not found
  1.  I +$$CODEN^ICPTCOD(CIN)<1 D ERR((TY_" not found in the CPT file (#81)")) S COUT="" G AQ
  1.  ;    found
  1.  I +$$CODEN^ICPTCOD(CIN)>0 D  G AQ
  1.  . S VAL=1,ERR="Valid "_TY
  1.  . S IENI=+$$CODEN^ICPTCOD(CIN)
  1.  . S TEMP=$$CPT^ICPTCOD(IENI)
  1.  . S NAME=$P(TEMP,U,3)
  1.  . S STATUS=$P(TEMP,U,7)
  1.  . S IFIN=$S(STATUS:"",1:1)
  1.  . S:(+(IFOUT)+(IFIN))>0 ERR="Inactive "_TY
  1.  G AQ
  1. AQ ; Assemble output string and quit
  1.  S X=$G(VAL)_U_$G(CIN)_U_$G(COUT)_U_$G(ERR)_U_FNUM
  1.  S X=X_U_DIC_U_$G(CHKD)_U_$G(IENI)_U_$G(IFIN)_U_$G(IENO)_U_$G(IFOUT)_U_$G(NAME)
  1.  F  Q:$E(X,$L(X))'="^"  S X=$E(X,1,($L(X)-1))
  1.  Q X
  1. ERR(X) S VAL=0,ERR=$G(X) Q