74 lines
2.6 KiB
Mathematica
74 lines
2.6 KiB
Mathematica
|
ICPTMOD2 ; ALB/DEK/KER - CPT MODIFIER APIS ; 09/06/2006
|
||
|
|
;;6.0;CPT/HCPCS;**30**;May 19, 1997;Build 1
|
||
|
|
;
|
||
|
|
; External References
|
||
|
|
; DBIA 10103 $$DT^XLFDT
|
||
|
|
;
|
||
|
|
Q
|
||
|
|
MODA ; Create an array of Modifiers for a CPT Code
|
||
|
|
;
|
||
|
|
; Input
|
||
|
|
;
|
||
|
|
; CODE CPT/HCPCS Code ?7N / ?1A4N / ?4N1A
|
||
|
|
; VDT Versioning Date (date service provided)
|
||
|
|
; .ARY Name of a Local Array passed by value
|
||
|
|
;
|
||
|
|
; Output
|
||
|
|
;
|
||
|
|
; ARY Only returns Active Modifiers
|
||
|
|
; ARY(0) = 4 Piece String
|
||
|
|
; 4 Piece String
|
||
|
|
; 1 # of Modifiers found for code CODE (input)
|
||
|
|
; 2 # of Modifiers w/Active Ranges
|
||
|
|
; 3 # of Modifiers w/Inactive Ranges
|
||
|
|
; 4 Code
|
||
|
|
;
|
||
|
|
; ARY(ST,MOD) = 8 Piece Output String
|
||
|
|
;
|
||
|
|
; ST Status A=Active I=Inactive
|
||
|
|
; MOD Modifier (external format)
|
||
|
|
; 8 Piece String
|
||
|
|
; 1 IEN of Modifier
|
||
|
|
; 2 Versioned Short Text (name)
|
||
|
|
; 3 Activation date of Modifier
|
||
|
|
; 4 Beginning Range Code
|
||
|
|
; 5 Ending Range Code
|
||
|
|
; 6 Activation Date of Range
|
||
|
|
; 7 Inactivation Date of Range
|
||
|
|
; 8 Modifier Identifier
|
||
|
|
;
|
||
|
|
N A,EFF,I,ID,MIEN,MOD,SRC,ST,X K ARY
|
||
|
|
S CODE=$G(CODE) Q:'$D(^ICPT("BA",(CODE_" ")))
|
||
|
|
S VDT=$G(VDT) S:+VDT'>0 VDT=$$DT^XLFDT Q:VDT'?7N
|
||
|
|
S SRC=3,MIEN=0 F S MIEN=$O(^DIC(81.3,MIEN)) Q:+MIEN'>0 D
|
||
|
|
. S (EFF,ST)=$O(^DIC(81.3,MIEN,60,"B"," "),-1) Q:ST'>0 S ST=$O(^DIC(81.3,MIEN,60,"B",ST," "),-1) Q:ST'>0 S ST=$P($G(^DIC(81.3,MIEN,60,ST,0)),"^",2) Q:ST'>0
|
||
|
|
. S MOD=$P($G(^DIC(81.3,MIEN,0)),"^",1) Q:'$L(MOD)
|
||
|
|
. S X=$$MODP^ICPTMOD(CODE,MIEN,"I",VDT,0) S ID=$P(X,"^",6) S ID=$S(+ID>0:"I",1:"A")
|
||
|
|
. S:+X>0 ARY(ID,MOD)=$P(X,"^",1,2)_"^"_EFF_"^"_$P(X,"^",3,7)
|
||
|
|
S (A,I)=0,ST="" F S ST=$O(ARY(ST)) Q:ST="" S MOD="" F S MOD=$O(ARY(ST,MOD)) Q:MOD="" S:ST="A" A=A+1 S:ST="I" I=I+1
|
||
|
|
S ST=A+I,ARY(0)=ST_"^"_A_"^"_I_"^"_CODE
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
MODC(MOD) ; Checks modifier for range including code, and active for date desired
|
||
|
|
;
|
||
|
|
; Input:
|
||
|
|
; MOD - modifier ien
|
||
|
|
;
|
||
|
|
N MODNM,MODEFF
|
||
|
|
S MODEFF=$$EFF^ICPTSUPT(81.3,MOD,MDT)
|
||
|
|
I '$P(MODEFF,"^",2) S STR="-1^modifier inactive" Q
|
||
|
|
S PR=CODEA_.0001,PR=$O(^DIC(81.3,MOD,"M",PR),-1)
|
||
|
|
I 'PR S STR=0 Q
|
||
|
|
S PRN=^DIC(81.3,MOD,"M",PR)
|
||
|
|
I 'PRN S STR="-1^bad modifier file entry" Q
|
||
|
|
I PRN<CODEA S STR=0 Q
|
||
|
|
S MODNM=$P($G(^DIC(81.3,MOD,0)),"^",2)
|
||
|
|
S STR=MOD_"^"_MODNM
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
MULT ; Finds iens for all modifiers with same 2-letter code
|
||
|
|
; MOD = .01, check B x-ref for other mods with equivalent .01 fields
|
||
|
|
; output concatenates ien of each mod to STR, separated by ":"
|
||
|
|
F MODN=0:0 S MODN=$O(^DIC(81.3,"B",MOD,MODN)) Q:'MODN S STR=STR_MODN_"; "
|
||
|
|
Q
|