[628] | 1 | ICPTMOD ;ALB/DEK/KER - CPT MODIFIER APIS ;08/18/2007
|
---|
| 2 | ;;6.0;CPT/HCPCS;**6,12,13,14,19,30,37**;May 19, 1997;Build 25
|
---|
| 3 | ;
|
---|
| 4 | ; Global Variables
|
---|
| 5 | ; ^DIC(81.3
|
---|
| 6 | ; ^TMP("ICPTD" SACC 2.3.2.5.1
|
---|
| 7 | ;
|
---|
| 8 | ; External References
|
---|
| 9 | ; $$DT^XLFDT DBIA 10103
|
---|
| 10 | ;
|
---|
| 11 | ; External References
|
---|
| 12 | ;
|
---|
| 13 | Q
|
---|
| 14 | MOD(MOD,MFT,MDT,SRC,DFN) ; returns basic info on CPT MODIFIERs
|
---|
| 15 | ;
|
---|
| 16 | ; Input: MOD Modifier, Internal or External (Required)
|
---|
| 17 | ; MFT Format "I"=IEN "E"=.01 field (Default)
|
---|
| 18 | ; MDT Version Date, FileMan format (default = TODAY)
|
---|
| 19 | ; SRC Source Screen
|
---|
| 20 | ; If 0 or Null, Level I and II only
|
---|
| 21 | ; If >0, Level I, II, and III
|
---|
| 22 | ; DFN Not used
|
---|
| 23 | ;
|
---|
| 24 | ; Output: 10 piece string delimited by the up-arrow (^)
|
---|
| 25 | ;
|
---|
| 26 | ; 1 IEN
|
---|
| 27 | ; 2 Modifier (0;1)
|
---|
| 28 | ; 3 Versioned Name (61, 0;1)
|
---|
| 29 | ; 4 Code (0;3)
|
---|
| 30 | ; 5 Source (0;4)
|
---|
| 31 | ; 6 Effective Date (60, 0;1)
|
---|
| 32 | ; 7 Status (60, 0;2) 0:inactive; 1:active
|
---|
| 33 | ; 8 Inactivation Date (60, 0;1)
|
---|
| 34 | ; 9 Activation Date (60, 0;1)
|
---|
| 35 | ; 10 Message
|
---|
| 36 | ; or
|
---|
| 37 | ; -1^Error
|
---|
| 38 | ;
|
---|
| 39 | N DATA,EFF,EFFX,EFFS,STR,MODN,MODST
|
---|
| 40 | I $G(MOD)="" S STR="-1^NO MODIFIER SELECTED" G MODQ
|
---|
| 41 | I $G(MFT)="" S MFT="E"
|
---|
| 42 | I "E^I"'[MFT S STR="-1^INVALID MODIFIER FORMAT" G MODQ
|
---|
| 43 | S MDT=$S($G(MDT)="":$$DT^XLFDT,1:$$DTBR^ICPTSUPT(MDT))
|
---|
| 44 | 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
|
---|
| 45 | I MFT="E" S MOD=MODN
|
---|
| 46 | S MOD=+MOD
|
---|
| 47 | I 'MOD!'$D(^DIC(81.3,MOD)) S STR="-1^NO SUCH MODIFIER" G MODQ
|
---|
| 48 | S DATA=$G(^DIC(81.3,MOD,0))
|
---|
| 49 | S MODST=$$VSTCM(MOD,MDT)
|
---|
| 50 | I '$L(DATA) S STR="-1^NO DATA" G MODQ
|
---|
| 51 | S STR=MOD_"^"_$P(DATA,"^",1,4)
|
---|
| 52 | I '$G(SRC),$P(STR,"^",5)="V" Q "-1^VA LOCAL MODIFIER SELECTED"
|
---|
| 53 | S EFF=$$EFF^ICPTSUPT(81.3,MOD,MDT)
|
---|
| 54 | I EFF<1 S $P(EFF,"^",2)=0
|
---|
| 55 | S STR=STR_"^"_EFF_"^"_$$MSG^ICPTSUPT(MDT)
|
---|
| 56 | S:$L(MODST) $P(STR,"^",3)=MODST
|
---|
| 57 | MODQ ; Modifier Quit
|
---|
| 58 | Q STR
|
---|
| 59 | ;
|
---|
| 60 | MODD(CODE,OUTARR,DFN,CDT) ; returns CPT description in array
|
---|
| 61 | ;
|
---|
| 62 | ; Input: CODE CPT Modifier, internal or external (Required)
|
---|
| 63 | ; ARY Output Array Name
|
---|
| 64 | ; e.g. "ABC" or "ABC("TEST")"
|
---|
| 65 | ; Default = ^TMP("ICPTD",$J)
|
---|
| 66 | ; DFN Not used
|
---|
| 67 | ; CDT Versioning Date (default = TODAY)
|
---|
| 68 | ; If prior to 1/1/1989, 1/1/1989 will be used
|
---|
| 69 | ; If year only, use first of that year
|
---|
| 70 | ; If month/year only, use first of the month
|
---|
| 71 | ; If later than today, TODAY will be used
|
---|
| 72 | ;
|
---|
| 73 | ; Output: # Number of lines in description
|
---|
| 74 | ;
|
---|
| 75 | ; @ARY(1:n) - Versioned Description (multiple 62)
|
---|
| 76 | ; @ARY(n+1) - blank
|
---|
| 77 | ; @ARY(n+1) - message: CODE TEXT MAY BE INACCURATE
|
---|
| 78 | ; or
|
---|
| 79 | ; -1^Error
|
---|
| 80 | ;
|
---|
| 81 | ; ** User must initialize ^TMP("ICPTD",$J), if used **
|
---|
| 82 | ;
|
---|
| 83 | N ARR,END,CTV,I,N
|
---|
| 84 | I $G(CODE)="" S N="-1^NO CODE SELECTED" G MODDQ
|
---|
| 85 | I $G(OUTARR)="" S OUTARR="^TMP(""ICPTD"",$J,"
|
---|
| 86 | I OUTARR'["(" S OUTARR=OUTARR_"("
|
---|
| 87 | I OUTARR[")" S OUTARR=$P(OUTARR,")")
|
---|
| 88 | S END=$E(OUTARR,$L(OUTARR)) I END'="("&(END'=",") S OUTARR=OUTARR_","
|
---|
| 89 | I OUTARR="^TMP(""ICPTD"",$J," K ^TMP("ICPTD",$J)
|
---|
| 90 | S CODE=$S(CODE?1.N:+CODE,1:$$CODEN(CODE)),I=0,N=0
|
---|
| 91 | I CODE<1!'$D(^DIC(81.3,CODE)) S N="-1^NO SUCH CODE" G MODDQ
|
---|
| 92 | S CDT=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR^ICPTSUPT(CDT))
|
---|
| 93 | D VLTCM(+CODE,CDT,.CTV)
|
---|
| 94 | S (N,I)=0 F S I=$O(CTV(I)) Q:+I=0 D
|
---|
| 95 | . S N=N+1,ARR=OUTARR_N_")",@ARR=$$TRIM($G(CTV(I)))
|
---|
| 96 | I +N>0 D
|
---|
| 97 | . S N=N+1,ARR=OUTARR_N_")",@ARR=" "
|
---|
| 98 | . S N=N+1,ARR=OUTARR_N_")",@ARR=$$MSG^ICPTSUPT(CDT,1)
|
---|
| 99 | I +N'>0 S N="-1^VERSIONED DESCRIPTION NOT FOUND FOR MODIFIER "_$P($G(^DIC(81.3,+CODE,0)),"^",1)
|
---|
| 100 | MODDQ ; Modifier Description Quit
|
---|
| 101 | Q N
|
---|
| 102 | ;
|
---|
| 103 | MODA(CODE,VDT,ARY) ; Return an array of Modifiers for a CPT Code
|
---|
| 104 | D MODA^ICPTMOD2 Q
|
---|
| 105 | MODP(CODE,MOD,MFT,MDT,SRC,DFN) ; Check if modifier can be used with code
|
---|
| 106 | Q $$MODP^ICPTMOD2($G(CODE),$G(MOD),$G(MFT),$G(MDT),$G(SRC),$G(DFN))
|
---|
| 107 | MODC(MOD) ; Checks modifier for range including code
|
---|
| 108 | D MODC^ICPTMOD2($G(MOD))
|
---|
| 109 | Q
|
---|
| 110 | MULT ; Finds Duplicate Modifiers
|
---|
| 111 | D MULT^ICPTMOD2 Q
|
---|
| 112 | CODEN(CODE) ; Return the IEN of a CPT modifier CODE
|
---|
| 113 | Q:$G(CODE)="" -1
|
---|
| 114 | N COD S COD=+$O(^DIC(81.3,"BA",(CODE_" "),0))
|
---|
| 115 | Q $S(COD>0:COD,1:-1)
|
---|
| 116 | VSTCM(IEN,VDATE) ; Versioned Short Text (CPT Modifier)
|
---|
| 117 | N CPT0,CPTC,CPTI,CPTSTD,CPTSTI,CPTVDT,CPTTXT,CPTTD,CPTTI
|
---|
| 118 | S CPTI=+($G(IEN)) Q:+CPTI'>0 "" Q:'$D(^DIC(81.3,+CPTI)) ""
|
---|
| 119 | S CPTVDT=$G(VDATE) S:'$L(CPTVDT)!(+CPTVDT'>0) CPTVDT=$$DT^XLFDT Q:$P(CPTVDT,".",1)'?7N ""
|
---|
| 120 | S CPT0=$G(^DIC(81.3,+CPTI,0)),CPTC=$P(CPT0,"^",1) Q:'$L(CPTC) ""
|
---|
| 121 | 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
|
---|
| 122 | . S CPTTI=$O(^DIC(81.3,"AST",(CPTC_" "),CPTTD," "),-1) S:CPTTI=CPTI CPTSTD=CPTTD
|
---|
| 123 | I +CPTSTD>0 D Q:$L($G(CPTTXT)) $G(CPTTXT)
|
---|
| 124 | . S CPTSTI=$O(^DIC(81.3,"AST",(CPTC_" "),CPTSTD,+CPTI," "),-1),CPTTXT=$P($G(^DIC(81.3,+CPTI,61,+CPTSTI,0)),"^",2)
|
---|
| 125 | S CPTSTD=$O(^DIC(81.3,+CPTI,61,"B",0)) I +CPTSTD>0 D Q:$L($G(CPTTXT)) $G(CPTTXT)
|
---|
| 126 | . S CPTSTI=$O(^DIC(81.3,+CPTI,61,"B",CPTSTD,0)),CPTTXT=$P($G(^DIC(81.3,+CPTI,61,+CPTSTI,0)),"^",2)
|
---|
| 127 | Q $$TRIM($P(CPT0,"^",2))
|
---|
| 128 | VLTCM(IEN,VDATE,ARY) ; Versioned Description - Long Text (CPT Modifier)
|
---|
| 129 | N CPT0,CPTC,CPTD,CPTI,CPTSTD,CPTSTI,CPTT,CPTVDT,CPTTXT,CPTTD,CPTTI
|
---|
| 130 | S CPTI=+($G(IEN)) Q:+CPTI'>0 Q:'$D(^DIC(81.3,+CPTI))
|
---|
| 131 | S CPTVDT=$G(VDATE) S:'$L(CPTVDT)!(+CPTVDT'>0) CPTVDT=$$DT^XLFDT Q:$P(CPTVDT,".",1)'?7N
|
---|
| 132 | S CPT0=$G(^DIC(81.3,+CPTI,0)),CPTC=$P(CPT0,"^",1) Q:'$L(CPTC)
|
---|
| 133 | 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
|
---|
| 134 | . S CPTTI=$O(^DIC(81.3,"ADS",(CPTC_" "),CPTTD," "),-1) S:CPTTI=CPTI CPTSTD=CPTTD
|
---|
| 135 | I +CPTSTD>0 D Q:+($O(ARY(0)))>0
|
---|
| 136 | . S CPTSTI=$O(^DIC(81.3,"ADS",(CPTC_" "),CPTSTD,+CPTI," "),-1)
|
---|
| 137 | . S (CPTD,CPTT)=0 F S CPTD=$O(^DIC(81.3,+CPTI,62,CPTSTI,1,CPTD)) Q:+CPTD=0 D
|
---|
| 138 | . . S CPTT=CPTT+1,ARY(CPTT)=$$TRIM($G(^DIC(81.3,+CPTI,62,+CPTSTI,1,+CPTD,0))),ARY(0)=CPTT
|
---|
| 139 | S CPTSTD=$O(^DIC(81.3,+CPTI,62,"B",0)) I +CPTSTD>0 D Q:+($O(ARY(0)))>0
|
---|
| 140 | . S CPTSTI=$O(^DIC(81.3,+CPTI,62,"B",CPTSTD,0))
|
---|
| 141 | . S (CPTD,CPTT)=0 F S CPTD=$O(^DIC(81.3,+CPTI,62,CPTSTI,1,CPTD)) Q:+CPTD=0 D
|
---|
| 142 | . . S CPTT=CPTT+1,ARY(CPTT)=$$TRIM($G(^DIC(81.3,+CPTI,62,+CPTSTI,1,+CPTD,0))),ARY(0)=CPTT
|
---|
| 143 | K ARY S (CPTD,CPTT)=0 F S CPTD=$O(^DIC(81.3,CPTI,"D",CPTD)) Q:+CPTD=0 D
|
---|
| 144 | . S CPTT=CPTT+1,ARY(CPTT)=$$TRIM($G(^DIC(81.3,CPTI,"D",CPTD,0))),ARY(0)=CPTT
|
---|
| 145 | Q
|
---|
| 146 | TRIM(X) ; Trim Spaces
|
---|
| 147 | S X=$G(X) Q:X="" X F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
|
---|
| 148 | F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
|
---|
| 149 | F Q:X'[" " S X=$P(X," ",1)_" "_$P(X," ",2,229)
|
---|
| 150 | Q X
|
---|
| 151 | MO(X) ; Modifier X = Modifier IEN
|
---|
| 152 | Q $P($G(^DIC(81.3,+($G(X)),0)),"^",1)
|
---|