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