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

ICPTMOD2.m

Go to the documentation of this file.
  1. ICPTMOD2 ;ALB/DEK/KER - CPT MODIFIER APIS ;08/18/2007
  1. ;;6.0;CPT/HCPCS;**30,37**;May 19, 1997;Build 25
  1. ;
  1. ; Global Variables
  1. ; ^DIC(81.3
  1. ; ^ICPT(
  1. ;
  1. ; External References
  1. ; $$DT^XLFDT DBIA 10103
  1. ; $$FMADD^XLFDT DBIA 10103
  1. ;
  1. Q
  1. MODA ; Create an array of Modifiers for a CPT Code
  1. ;
  1. ; Input
  1. ;
  1. ; CODE CPT/HCPCS Code ?7N / ?1A4N / ?4N1A
  1. ; VDT Versioning Date (date service provided)
  1. ; .ARY Name of a Local Array passed by value
  1. ;
  1. ; Output
  1. ;
  1. ; ARY Only returns Active Modifiers
  1. ; ARY(0) = 4 Piece String
  1. ; 4 Piece String
  1. ; 1 # of Modifiers found for code CODE (input)
  1. ; 2 # of Modifiers w/Active Ranges
  1. ; 3 # of Modifiers w/Inactive Ranges
  1. ; 4 Code
  1. ;
  1. ; ARY(ST,MOD) = 8 Piece Output String
  1. ;
  1. ; ST Status A=Active I=Inactive
  1. ; MOD Modifier (external format)
  1. ; 8 Piece String
  1. ; 1 IEN of Modifier
  1. ; 2 Versioned Short Text (name)
  1. ; 3 Activation date of Modifier
  1. ; 4 Beginning Range Code
  1. ; 5 Ending Range Code
  1. ; 6 Activation Date of Range
  1. ; 7 Inactivation Date of Range
  1. ; 8 Modifier Identifier
  1. ;
  1. N A,EFF,I,ID,MIEN,MOD,SRC,ST,X K ARY
  1. S CODE=$G(CODE) Q:'$D(^ICPT("BA",(CODE_" ")))
  1. S VDT=$G(VDT) S:+VDT'>0 VDT=$$DT^XLFDT Q:VDT'?7N
  1. S SRC=3,MIEN=0 F S MIEN=$O(^DIC(81.3,MIEN)) Q:+MIEN'>0 D
  1. . 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
  1. . S MOD=$P($G(^DIC(81.3,MIEN,0)),"^",1) Q:'$L(MOD)
  1. . S X=$$MODP(CODE,MIEN,"I",VDT,0) S ID=$P(X,"^",6) S ID=$S(+ID>0:"I",1:"A")
  1. . S:+X>0 ARY(ID,MOD)=$P(X,"^",1,2)_"^"_EFF_"^"_$P(X,"^",3,7)
  1. 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
  1. S ST=A+I,ARY(0)=ST_"^"_A_"^"_I_"^"_CODE
  1. Q
  1. ;
  1. MODP(CODE,MOD,MFT,MDT,SRC,DFN) ; Check if modifier can be used with code (pair)
  1. ;
  1. ; Input:
  1. ;
  1. ; CODE CPT/HCPCS Code ?7N / ?1A4N / ?4N1A
  1. ; MOD Modifier (External or Internal)
  1. ; MFT Modifier Format "E" - or "I"
  1. ; VDT Date service provided
  1. ; SRC Source Screen
  1. ; If 0 or Null, Level I and II modifiers
  1. ; If >0, Level I, II, and III modifiers
  1. ; Output:
  1. ;
  1. ; If pair is acceptable - Positive "^" Delimited String
  1. ;
  1. ; 1 - IEN of CPT Modifier
  1. ; 2 - Versioned Short Text
  1. ; 3 - Beginning Code for Code Range
  1. ; 4 - Ending Code for Code Range
  1. ; 5 - Code Range Activaiton Date
  1. ; 6 - Code Range Inactivation Date
  1. ; 7 - Modifier Identifier
  1. ;
  1. ; If pair is unacceptable
  1. ;
  1. ; 0 or
  1. ; -1 with error message
  1. ;
  1. N ADT,BEGA,BEGR,CDT,CODEA,CODN,ENDA,ENDR,ICD,IDT,LACT,LINA,MIEN,MODEFF,MODI,MODNM,MODST,ND,NSTA,RIEN,RSTA,SIEN,STA,STI,STX,TA,TEFF,TI,TIEN,VDT
  1. S:$G(MFT)="" MFT="E" Q:"^E^I^"'[("^"_MFT_"^") "-1^Invalid Modifier Format" S VDT=$P($G(MDT),".",1)
  1. S:+VDT'?7N VDT=$$DT^XLFDT S:VDT#10000=0 VDT=VDT+101 S:VDT#100=0 VDT=VDT+1 S VDT=$S(VDT<2890101:2890101,1:VDT)
  1. Q:+VDT'>0!(VDT'?7N) "-1^Invalid Date" I MFT="E" D I +($G(MIEN))'>0 Q "-1^Multiple Modifiers with the same name, use IEN"
  1. . S MIEN=0 S (TIEN,TI)=0 F S TIEN=$O(^DIC(81.3,"B",MOD,TIEN)) Q:+TIEN'>0 D
  1. . . S TEFF=$$EFF^ICPTSUPT(81.3,TIEN,VDT) Q:'$P(TEFF,"^",2) S TI=TI+1,TA(TI)=TIEN,TA(0)=TI
  1. . S:+($G(TA(0)))=1 MIEN=+($G(TA(1)))
  1. S:MFT="I" MIEN=+MOD S CODE=$G(CODE),CODN=$S(CODE?1.N:+CODE,1:$$CODEN^ICPTCOD(CODE)) I CODN<1!'$D(^ICPT(CODN,0)) Q "-1^NO SUCH CPT CODE"
  1. S CODE=$P($G(^ICPT(CODN,0)),"^") Q:'$L(CODE) "-1^No such CPT Code" Q:$L(CODE)'=5 "-1^Invalid Code"
  1. S CODEA=$S(CODE?1N.4N:+CODE,CODE?4N1A:$A($E(CODE,5))*10_$E(CODE,1,4),1:$A(CODE)_$E(CODE,2,5)) Q:+CODEA'>0 "-1^Invalid Code Source"
  1. S MIEN=$G(MIEN) Q:+MIEN'>0 "-1^Invalid Modifier" S SRC=$S(+($G(SRC))>0:1,1:0),SIEN=$O(^ICPT("BA",(CODE_" "),0)) Q:+SIEN'>0 "-3^Invalid Code"
  1. Q:$P($G(^ICPT(+SIEN,0)),"^",6)="L"&(SRC'>0) "-1^Invalid Code Source"
  1. S MODEFF=$$EFF^ICPTSUPT(81.3,MIEN,VDT) Q:'$P(MODEFF,"^",2) "-1^Modifier Inactive"
  1. S MODNM=$P($G(^DIC(81.3,MIEN,0)),"^",2) Q:'$L(MODNM) "-1^Invalid Modifier Name"
  1. S MODI=$P($G(^DIC(81.3,MIEN,0)),"^",1) Q:'$L(MODI) "-1^Invalid Modifier ID"
  1. S MODST=$$VSTCM^ICPTMOD(MIEN,VDT) K STX S (STA,STI)=0 S CDT=VDT+.001
  1. S (LINA,LACT)="",RSTA=0,RIEN=0 F S RIEN=$O(^DIC(81.3,MIEN,10,RIEN)) Q:+RIEN'>0 D
  1. . N NSTA S NSTA=0,ND=$G(^DIC(81.3,MIEN,10,RIEN,0))
  1. . S BEGR=$P(ND,"^",1) Q:$L(BEGR)'=5 S BEGA=$S(BEGR?1N.4N:+BEGR,BEGR?4N1A:$A($E(BEGR,5))*10_$E(BEGR,1,4),1:$A(BEGR)_$E(BEGR,2,5)) Q:+CODEA<+BEGA
  1. . S ENDR=$P(ND,"^",2) S:$L(ENDR)'=5 ENDR=BEGR S ENDA=$S(ENDR?1N.4N:+ENDR,ENDR?4N1A:$A($E(ENDR,5))*10_$E(ENDR,1,4),1:$A(ENDR)_$E(ENDR,2,5))
  1. . Q:$L(ENDR)&(CODEA>ENDA) S ADT=$P(ND,"^",3),(ICD,IDT)=$P(ND,"^",4) S:ADT="" ADT=2890101
  1. . I +CODEA'<+BEGA,+CODEA'>ENDA,+ADT>0,+IDT'>0 S RSTA=1,NSTA=1 S:+ADT>0&(+ADT>(+LACT)) LACT=+ADT
  1. . I +CODEA'<+BEGA,+CODEA'>ENDA,+ADT>0,+IDT>0,CDT>ADT,CDT'>IDT S RSTA=1,NSTA=1 S:+ADT>0&(+ADT>(+LACT)) LACT=+ADT
  1. . I +CODEA'<+BEGA,+CODEA'>ENDA,+ADT>0,+IDT>0 S:+IDT>0&(+IDT>(+LINA)) LINA=+IDT
  1. . Q:NSTA'>0 S:'$L(IDT) IDT=$$FMADD^XLFDT($$DT^XLFDT,365) S ADT=$P(ND,"^",3),(ICD,IDT)=$P(ND,"^",4) S:ADT="" ADT=2890101
  1. . S:'$L(IDT) IDT=$$FMADD^XLFDT($$DT^XLFDT,365) S STA=+($G(STA))+1,STX(STA)=MIEN_"^"_MODST_"^"_BEGR_"^"_ENDR_"^"_ADT_"^"_ICD_"^"_MODI,STX("B",+ADT,+STA)=""
  1. S:+LACT>0&(+LINA>0)&(LINA'>CDT)&(+LINA>+LACT) RSTA=0
  1. S ADT=$O(STX("B",+CDT),-1),STA=$O(STX("B",+ADT," "),-1),MOD=$G(STX(+STA))
  1. Q:+MOD'>0 "0" Q:+RSTA'>0 "0"
  1. Q MOD
  1. ;
  1. MODC(MOD) ; Checks modifier for active range including code
  1. ;
  1. ; Input:
  1. ; MOD - modifier ien
  1. ;
  1. N MODNM,MODEFF
  1. S MODEFF=$$EFF^ICPTSUPT(81.3,MOD,MDT)
  1. I '$P(MODEFF,"^",2) S STR="-1^modifier inactive" Q
  1. S PR=CODEA_.0001,PR=$O(^DIC(81.3,MOD,"M",PR),-1)
  1. I 'PR S STR=0 Q
  1. S PRN=^DIC(81.3,MOD,"M",PR)
  1. I 'PRN S STR="-1^bad modifier file entry" Q
  1. I PRN<CODEA S STR=0 Q
  1. S MODNM=$P($G(^DIC(81.3,MOD,0)),"^",2)
  1. S STR=MOD_"^"_MODNM
  1. Q
  1. ;
  1. MULT ; Finds iens for all modifiers with same 2-letter code
  1. ; MOD = .01, check B x-ref for dupliate .01 fields
  1. ; Output:
  1. ; STR - a ";" delimited string of IENS for modifier MOD
  1. F MODN=0:0 S MODN=$O(^DIC(81.3,"B",MOD,MODN)) Q:'MODN S STR=STR_MODN_"; "
  1. Q