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

ICPTMOD.m

Go to the documentation of this file. 
  1. ICPTMOD ;ALB/DEK/KER - CPT MODIFIER APIS ;08/18/2007
  1.  ;;6.0;CPT/HCPCS;**6,12,13,14,19,30,37**;May 19, 1997;Build 44
  1.  ;             
  1.  ; Global Variables
  1.  ;    ^DIC(81.3
  1.  ;    ^TMP("ICPTD"     SACC 2.3.2.5.1
  1.  ;             
  1.  ; External References
  1.  ;    $$DT^XLFDT       DBIA  10103
  1.  ;             
  1.  ; External References
  1.  ;
  1.  Q
  1. MOD(MOD,MFT,MDT,SRC,DFN) ;  returns basic info on CPT MODIFIERs
  1.  ;
  1.  ; Input:   MOD   Modifier, Internal or External (Required)
  1.  ;          MFT   Format  "I"=IEN  "E"=.01 field (Default)
  1.  ;          MDT   Version Date, FileMan format (default = TODAY)
  1.  ;          SRC   Source Screen
  1.  ;                  If 0 or Null, Level I and II only
  1.  ;                  If >0, Level I, II, and III
  1.  ;          DFN   Not used
  1.  ; 
  1.  ; Output:  10 piece string delimited by the up-arrow (^)
  1.  ; 
  1.  ;            1  IEN
  1.  ;            2  Modifier (0;1)
  1.  ;            3  Versioned Name (61, 0;1)
  1.  ;            4  Code (0;3)
  1.  ;            5  Source (0;4)
  1.  ;            6  Effective Date (60, 0;1)
  1.  ;            7  Status (60, 0;2) 0:inactive; 1:active
  1.  ;            8  Inactivation Date (60, 0;1)
  1.  ;            9  Activation Date (60, 0;1)
  1.  ;           10  Message
  1.  ;        or 
  1.  ;           -1^Error
  1.  ; 
  1.  N DATA,EFF,EFFX,EFFS,STR,MODN,MODST
  1.  I $G(MOD)="" S STR="-1^NO MODIFIER SELECTED" G MODQ
  1.  I $G(MFT)="" S MFT="E"
  1.  I "E^I"'[MFT S STR="-1^INVALID MODIFIER FORMAT" G MODQ
  1.  S MDT=$S($G(MDT)="":$$DT^XLFDT,1:$$DTBR^ICPTSUPT(MDT))
  1.  I MFT="E" S MODN=$O(^DIC(81.3,"B",MOD,0)) I $O(^(MODN)) S STR="-1^Multiple modifiers w/same name.  Select IEN: " D MULT G MODQ
  1.  I MFT="E" S MOD=MODN
  1.  S MOD=+MOD
  1.  I 'MOD!'$D(^DIC(81.3,MOD)) S STR="-1^NO SUCH MODIFIER" G MODQ
  1.  S DATA=$G(^DIC(81.3,MOD,0))
  1.  S MODST=$$VSTCM(MOD,MDT)
  1.  I '$L(DATA) S STR="-1^NO DATA" G MODQ
  1.  S STR=MOD_"^"_$P(DATA,"^",1,4)
  1.  I '$G(SRC),$P(STR,"^",5)="V" Q "-1^VA LOCAL MODIFIER SELECTED"
  1.  S EFF=$$EFF^ICPTSUPT(81.3,MOD,MDT)
  1.  I EFF<1 S $P(EFF,"^",2)=0
  1.  S STR=STR_"^"_EFF_"^"_$$MSG^ICPTSUPT(MDT)
  1.  S:$L(MODST) $P(STR,"^",3)=MODST
  1. MODQ ; Modifier Quit
  1.  Q STR
  1.  ;
  1. MODD(CODE,OUTARR,DFN,CDT)       ; returns CPT description in array
  1.  ;
  1.  ; Input:   CODE   CPT Modifier, internal or external (Required)
  1.  ;          ARY    Output Array Name
  1.  ;                   e.g. "ABC" or "ABC("TEST")" 
  1.  ;                   Default = ^TMP("ICPTD",$J)
  1.  ;          DFN    Not used
  1.  ;          CDT    Versioning Date (default = TODAY)
  1.  ;                   If prior to 1/1/1989, 1/1/1989 will be used
  1.  ;                   If year only, use first of that year
  1.  ;                   If month/year only, use first of the month
  1.  ;                   If later than today, TODAY will be used
  1.  ; 
  1.  ; Output:  #      Number of lines in description
  1.  ; 
  1.  ;          @ARY(1:n) - Versioned Description (multiple 62)
  1.  ;          @ARY(n+1) - blank
  1.  ;          @ARY(n+1) - message: CODE TEXT MAY BE INACCURATE
  1.  ;      or
  1.  ;          -1^Error
  1.  ; 
  1.  ;  ** User must initialize ^TMP("ICPTD",$J), if used **
  1.  ; 
  1.  N ARR,END,CTV,I,N
  1.  I $G(CODE)="" S N="-1^NO CODE SELECTED" G MODDQ
  1.  I $G(OUTARR)="" S OUTARR="^TMP(""ICPTD"",$J,"
  1.  I OUTARR'["(" S OUTARR=OUTARR_"("
  1.  I OUTARR[")" S OUTARR=$P(OUTARR,")")
  1.  S END=$E(OUTARR,$L(OUTARR)) I END'="("&(END'=",") S OUTARR=OUTARR_","
  1.  I OUTARR="^TMP(""ICPTD"",$J," K ^TMP("ICPTD",$J)
  1.  S CODE=$S(CODE?1.N:+CODE,1:$$CODEN(CODE)),I=0,N=0
  1.  I CODE<1!'$D(^DIC(81.3,CODE)) S N="-1^NO SUCH CODE" G MODDQ
  1.  S CDT=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR^ICPTSUPT(CDT))
  1.  D VLTCM(+CODE,CDT,.CTV)
  1.  S (N,I)=0 F  S I=$O(CTV(I)) Q:+I=0  D
  1.  . S N=N+1,ARR=OUTARR_N_")",@ARR=$$TRIM($G(CTV(I)))
  1.  I +N>0 D
  1.  . S N=N+1,ARR=OUTARR_N_")",@ARR=" "
  1.  . S N=N+1,ARR=OUTARR_N_")",@ARR=$$MSG^ICPTSUPT(CDT,1)
  1.  I +N'>0 S N="-1^VERSIONED DESCRIPTION NOT FOUND FOR MODIFIER "_$P($G(^DIC(81.3,+CODE,0)),"^",1)
  1. MODDQ ; Modifier Description Quit
  1.  Q N
  1.  ;
  1. MODA(CODE,VDT,ARY) ; Return an array of Modifiers for a CPT Code
  1.  D MODA^ICPTMOD2 Q
  1. MODP(CODE,MOD,MFT,MDT,SRC,DFN) ;  Check if modifier can be used with code
  1.  Q $$MODP^ICPTMOD2($G(CODE),$G(MOD),$G(MFT),$G(MDT),$G(SRC),$G(DFN))
  1. MODC(MOD) ; Checks modifier for range including code
  1.  D MODC^ICPTMOD2($G(MOD))
  1.  Q
  1. MULT ; Finds Duplicate Modifiers
  1.  D MULT^ICPTMOD2 Q
  1. CODEN(CODE)    ; Return the IEN of a CPT modifier CODE
  1.  Q:$G(CODE)="" -1
  1.  N COD S COD=+$O(^DIC(81.3,"BA",(CODE_" "),0))
  1.  Q $S(COD>0:COD,1:-1)
  1. VSTCM(IEN,VDATE) ; Versioned Short Text (CPT Modifier)
  1.  N CPT0,CPTC,CPTI,CPTSTD,CPTSTI,CPTVDT,CPTTXT,CPTTD,CPTTI
  1.  S CPTI=+($G(IEN)) Q:+CPTI'>0 ""  Q:'$D(^DIC(81.3,+CPTI)) ""
  1.  S CPTVDT=$G(VDATE) S:'$L(CPTVDT)!(+CPTVDT'>0) CPTVDT=$$DT^XLFDT Q:$P(CPTVDT,".",1)'?7N ""
  1.  S CPT0=$G(^DIC(81.3,+CPTI,0)),CPTC=$P(CPT0,"^",1) Q:'$L(CPTC) ""
  1.  S CPTSTD=0 S CPTTD=CPTVDT+.000001 F  S CPTTD=$O(^DIC(81.3,"AST",(CPTC_" "),CPTTD),-1) Q:+CPTTD=0  Q:+CPTSTD>0  D
  1.  . S CPTTI=$O(^DIC(81.3,"AST",(CPTC_" "),CPTTD," "),-1) S:CPTTI=CPTI CPTSTD=CPTTD
  1.  I +CPTSTD>0 D  Q:$L($G(CPTTXT)) $G(CPTTXT)
  1.  . S CPTSTI=$O(^DIC(81.3,"AST",(CPTC_" "),CPTSTD,+CPTI," "),-1),CPTTXT=$P($G(^DIC(81.3,+CPTI,61,+CPTSTI,0)),"^",2)
  1.  S CPTSTD=$O(^DIC(81.3,+CPTI,61,"B",0)) I +CPTSTD>0 D  Q:$L($G(CPTTXT)) $G(CPTTXT)
  1.  . S CPTSTI=$O(^DIC(81.3,+CPTI,61,"B",CPTSTD,0)),CPTTXT=$P($G(^DIC(81.3,+CPTI,61,+CPTSTI,0)),"^",2)
  1.  Q $$TRIM($P(CPT0,"^",2))
  1. VLTCM(IEN,VDATE,ARY) ; Versioned Description - Long Text (CPT Modifier)
  1.  N CPT0,CPTC,CPTD,CPTI,CPTSTD,CPTSTI,CPTT,CPTVDT,CPTTXT,CPTTD,CPTTI
  1.  S CPTI=+($G(IEN)) Q:+CPTI'>0  Q:'$D(^DIC(81.3,+CPTI))
  1.  S CPTVDT=$G(VDATE) S:'$L(CPTVDT)!(+CPTVDT'>0) CPTVDT=$$DT^XLFDT Q:$P(CPTVDT,".",1)'?7N
  1.  S CPT0=$G(^DIC(81.3,+CPTI,0)),CPTC=$P(CPT0,"^",1) Q:'$L(CPTC)
  1.  S CPTSTD=0 S CPTTD=CPTVDT+.000001 F  S CPTTD=$O(^DIC(81.3,"ADS",(CPTC_" "),CPTTD),-1) Q:+CPTTD=0  Q:+CPTSTD>0  D
  1.  . S CPTTI=$O(^DIC(81.3,"ADS",(CPTC_" "),CPTTD," "),-1) S:CPTTI=CPTI CPTSTD=CPTTD
  1.  I +CPTSTD>0 D  Q:+($O(ARY(0)))>0
  1.  . S CPTSTI=$O(^DIC(81.3,"ADS",(CPTC_" "),CPTSTD,+CPTI," "),-1)
  1.  . S (CPTD,CPTT)=0 F  S CPTD=$O(^DIC(81.3,+CPTI,62,CPTSTI,1,CPTD)) Q:+CPTD=0  D
  1.  . . S CPTT=CPTT+1,ARY(CPTT)=$$TRIM($G(^DIC(81.3,+CPTI,62,+CPTSTI,1,+CPTD,0))),ARY(0)=CPTT
  1.  S CPTSTD=$O(^DIC(81.3,+CPTI,62,"B",0)) I +CPTSTD>0 D  Q:+($O(ARY(0)))>0
  1.  . S CPTSTI=$O(^DIC(81.3,+CPTI,62,"B",CPTSTD,0))
  1.  . S (CPTD,CPTT)=0 F  S CPTD=$O(^DIC(81.3,+CPTI,62,CPTSTI,1,CPTD)) Q:+CPTD=0  D
  1.  . . S CPTT=CPTT+1,ARY(CPTT)=$$TRIM($G(^DIC(81.3,+CPTI,62,+CPTSTI,1,+CPTD,0))),ARY(0)=CPTT
  1.  K ARY S (CPTD,CPTT)=0 F  S CPTD=$O(^DIC(81.3,CPTI,"D",CPTD)) Q:+CPTD=0  D
  1.  . S CPTT=CPTT+1,ARY(CPTT)=$$TRIM($G(^DIC(81.3,CPTI,"D",CPTD,0))),ARY(0)=CPTT
  1.  Q
  1. TRIM(X) ; Trim Spaces
  1.  S X=$G(X) Q:X="" X F  Q:$E(X,1)'=" "  S X=$E(X,2,$L(X))
  1.  F  Q:$E(X,$L(X))'=" "  S X=$E(X,1,($L(X)-1))
  1.  F  Q:X'["  "  S X=$P(X,"  ",1)_" "_$P(X,"  ",2,229)
  1.  Q X
  1. MO(X) ; Modifier             X = Modifier IEN
  1.  Q $P($G(^DIC(81.3,+($G(X)),0)),"^",1)