[613] | 1 | ICPTMOD2 ; ALB/DEK/KER - CPT MODIFIER APIS ; 09/06/2006
|
---|
| 2 | ;;6.0;CPT/HCPCS;**30**;May 19, 1997;Build 1
|
---|
| 3 | ;
|
---|
| 4 | ; External References
|
---|
| 5 | ; DBIA 10103 $$DT^XLFDT
|
---|
| 6 | ;
|
---|
| 7 | Q
|
---|
| 8 | MODA ; Create an array of Modifiers for a CPT Code
|
---|
| 9 | ;
|
---|
| 10 | ; Input
|
---|
| 11 | ;
|
---|
| 12 | ; CODE CPT/HCPCS Code ?7N / ?1A4N / ?4N1A
|
---|
| 13 | ; VDT Versioning Date (date service provided)
|
---|
| 14 | ; .ARY Name of a Local Array passed by value
|
---|
| 15 | ;
|
---|
| 16 | ; Output
|
---|
| 17 | ;
|
---|
| 18 | ; ARY Only returns Active Modifiers
|
---|
| 19 | ; ARY(0) = 4 Piece String
|
---|
| 20 | ; 4 Piece String
|
---|
| 21 | ; 1 # of Modifiers found for code CODE (input)
|
---|
| 22 | ; 2 # of Modifiers w/Active Ranges
|
---|
| 23 | ; 3 # of Modifiers w/Inactive Ranges
|
---|
| 24 | ; 4 Code
|
---|
| 25 | ;
|
---|
| 26 | ; ARY(ST,MOD) = 8 Piece Output String
|
---|
| 27 | ;
|
---|
| 28 | ; ST Status A=Active I=Inactive
|
---|
| 29 | ; MOD Modifier (external format)
|
---|
| 30 | ; 8 Piece String
|
---|
| 31 | ; 1 IEN of Modifier
|
---|
| 32 | ; 2 Versioned Short Text (name)
|
---|
| 33 | ; 3 Activation date of Modifier
|
---|
| 34 | ; 4 Beginning Range Code
|
---|
| 35 | ; 5 Ending Range Code
|
---|
| 36 | ; 6 Activation Date of Range
|
---|
| 37 | ; 7 Inactivation Date of Range
|
---|
| 38 | ; 8 Modifier Identifier
|
---|
| 39 | ;
|
---|
| 40 | N A,EFF,I,ID,MIEN,MOD,SRC,ST,X K ARY
|
---|
| 41 | S CODE=$G(CODE) Q:'$D(^ICPT("BA",(CODE_" ")))
|
---|
| 42 | S VDT=$G(VDT) S:+VDT'>0 VDT=$$DT^XLFDT Q:VDT'?7N
|
---|
| 43 | S SRC=3,MIEN=0 F S MIEN=$O(^DIC(81.3,MIEN)) Q:+MIEN'>0 D
|
---|
| 44 | . 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
|
---|
| 45 | . S MOD=$P($G(^DIC(81.3,MIEN,0)),"^",1) Q:'$L(MOD)
|
---|
| 46 | . S X=$$MODP^ICPTMOD(CODE,MIEN,"I",VDT,0) S ID=$P(X,"^",6) S ID=$S(+ID>0:"I",1:"A")
|
---|
| 47 | . S:+X>0 ARY(ID,MOD)=$P(X,"^",1,2)_"^"_EFF_"^"_$P(X,"^",3,7)
|
---|
| 48 | 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
|
---|
| 49 | S ST=A+I,ARY(0)=ST_"^"_A_"^"_I_"^"_CODE
|
---|
| 50 | Q
|
---|
| 51 | ;
|
---|
| 52 | MODC(MOD) ; Checks modifier for range including code, and active for date desired
|
---|
| 53 | ;
|
---|
| 54 | ; Input:
|
---|
| 55 | ; MOD - modifier ien
|
---|
| 56 | ;
|
---|
| 57 | N MODNM,MODEFF
|
---|
| 58 | S MODEFF=$$EFF^ICPTSUPT(81.3,MOD,MDT)
|
---|
| 59 | I '$P(MODEFF,"^",2) S STR="-1^modifier inactive" Q
|
---|
| 60 | S PR=CODEA_.0001,PR=$O(^DIC(81.3,MOD,"M",PR),-1)
|
---|
| 61 | I 'PR S STR=0 Q
|
---|
| 62 | S PRN=^DIC(81.3,MOD,"M",PR)
|
---|
| 63 | I 'PRN S STR="-1^bad modifier file entry" Q
|
---|
| 64 | I PRN<CODEA S STR=0 Q
|
---|
| 65 | S MODNM=$P($G(^DIC(81.3,MOD,0)),"^",2)
|
---|
| 66 | S STR=MOD_"^"_MODNM
|
---|
| 67 | Q
|
---|
| 68 | ;
|
---|
| 69 | MULT ; Finds iens for all modifiers with same 2-letter code
|
---|
| 70 | ; MOD = .01, check B x-ref for other mods with equivalent .01 fields
|
---|
| 71 | ; output concatenates ien of each mod to STR, separated by ":"
|
---|
| 72 | F MODN=0:0 S MODN=$O(^DIC(81.3,"B",MOD,MODN)) Q:'MODN S STR=STR_MODN_"; "
|
---|
| 73 | Q
|
---|