ICPTID.m

ICPTID ;SLC/KER - CPT IDENTIFIERS ; 04/18/2004

 ;;6.0;CPT/HCPCS;**19**;May 19, 1997

 ;

 ; External References

 ;   DBIA   2056  $$GET1^DIQ

 ;   DBIA  10103  $$DT^XLFDT

 ;                 

 Q

 ; Versioned Identifiers use the following

 ; input parameters:

 ;                   

 ;    X    Fileman's Internal Entry Number

 ;    Y    DD Field Number

 ;                   

 ; Format for using Identifiers

 ;                   

 ;   ^DD(file,0,"ID",field)=

 ;        D EN^DDIOL(("   "_$$IDCP^ICPTID(+Y,field)),"","?0")

 ;                       

IDCP(Y,X) ; CPT/HCPCS Identifiers (versioned)

 N FLD,MSG,CODE S FLD=+($G(X)),Y=+($G(Y)) Q:+FLD'>0 ""  Q:+Y'>0 ""

 S:'$D(DT) DT=$$DT^XLFDT I '$D(ICPTVDT) N ICPTVDT S ICPTVDT=DT

 S MSG=$$MSG^ICPTSUPT($G(ICPTVDT),1),CODE=$P($G(^ICPT(+Y,0)),U,1)

 I FLD=2 S X=$$VSTCP^ICPTCOD(+Y,$G(ICPTVDT))_$S($L(MSG):("  ("_MSG_")"),1:"") Q X

 I FLD=5 S X=$$STA(+($$STATCHK^ICPTAPIU(CODE,$G(ICPTVDT)))) Q X

 I FLD=50!(FLD=60)!(FLD=61)!(FLD=62) Q ""

 S X=$$GET1^DIQ(81,(+($G(Y))_","),FLD)

 Q X

IDCPS(Y) ; CPT/HCPCS Identifiers (versioned - short)

 N ICID,MSG,CODE,ST,X S Y=+($G(Y)) Q:+Y'>0 ""

 S:'$D(DT) DT=$$DT^XLFDT I '$D(ICPTVDT) N ICPTVDT S ICPTVDT=DT

 S MSG=$$MSG^ICPTSUPT($G(ICPTVDT),1) S:MSG["CODE " MSG="Text may be inaccurate"

 S CODE=$P($G(^ICPT(+Y,0)),U,1)

 S ICID=$$VSTCP^ICPTCOD(+Y,$G(ICPTVDT)) S:$L(MSG) ICID=ICID_"  ("_MSG_")"

 S ST=$$STA(+($$STATCHK^ICPTAPIU(CODE,$G(ICPTVDT))))

 S:$L(ST) ICID=ICID_$S('$L(MSG):" ",1:"")_" "_ST

 F  Q:$E(ICID,1)'=" "  S ICID=$E(ICID,2,$L(ICID))

 S Y=ICID

 Q Y

IDMD(Y,X) ; CPT Modifier Identifiers (versioned)

 N FLD,MSG,CODE S FLD=+($G(X)),Y=+($G(Y)) Q:+FLD'>0 ""  Q:+Y'>0 ""

 S:'$D(DT) DT=$$DT^XLFDT I '$D(ICPTVDT) N ICPTVDT S ICPTVDT=DT

 S MSG=$$MSG^ICPTSUPT($G(ICPTVDT),1)

 I FLD=.02 S X=$$VSTCM^ICPTMOD(+Y,$G(ICPTVDT))_$S($L(MSG):("  ("_MSG_")"),1:"") Q X

 I FLD=5 D  Q X

 . N VD,I S VD=$O(^DIC(81.3,+Y,60,"B"," "),-1)

 . S I=+($O(^DIC(81.3,+Y,60,"B",+VD," "),-1))

 . S X=$$STA(+($P($G(^DIC(81.3,+Y,60,+I,0)),U,2)))

 I FLD=10!(FLD=50)!(FLD=60)!(FLD=61)!(FLD=62) Q ""

 S X=$$GET1^DIQ(81.3,(+($G(Y))_","),FLD)

 Q X

IDMDS(Y) ; CPT Modifier Identifiers (versioned - short)

 N ICID,MSG,CODE,ST,X,VD,VI S Y=+($G(Y)) Q:+Y'>0 ""

 S:'$D(DT) DT=$$DT^XLFDT I '$D(ICPTVDT) N ICPTVDT S ICPTVDT=DT

 S MSG=$$MSG^ICPTSUPT($G(ICPTVDT),1) S:MSG["CODE " MSG="Text may be inaccurate"

 S ICID=$$VSTCM^ICPTMOD(+Y,$G(ICPTVDT)) S:$L(MSG) ICID=ICID_"  ("_MSG_")"

 S VD=$O(^DIC(81.3,+Y,60,"B"," "),-1)

 S VI=+($O(^DIC(81.3,+Y,60,"B",+VD," "),-1))

 S ST=$$STA(+($P($G(^DIC(81.3,+Y,60,+VI,0)),U,2)))

 S:$L(ST) ICID=ICID_$S('$L(MSG):" ",1:"")_" "_ST

 F  Q:$E(ICID,1)'=" "  S ICID=$E(ICID,2,$L(ICID))

 S Y=ICID

 Q Y

STA(X) ; Status

 Q $S(+($G(X)):"",1:"INACTIVE")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ICPTID   2772     printed  Mar 13, 2025@20:50:22                                                                                                                                                                                                      Page 2

ICPTID    ;SLC/KER - CPT IDENTIFIERS ; 04/18/2004

 +1       ;;6.0;CPT/HCPCS;**19**;May 19, 1997

 +2       ;

 +3       ; External References

 +4       ;   DBIA   2056  $$GET1^DIQ

 +5       ;   DBIA  10103  $$DT^XLFDT

 +6       ;                 

 +7        QUIT 

 +8       ; Versioned Identifiers use the following

 +9       ; input parameters:

 +10      ;                   

 +11      ;    X    Fileman's Internal Entry Number

 +12      ;    Y    DD Field Number

 +13      ;                   

 +14      ; Format for using Identifiers

 +15      ;                   

 +16      ;   ^DD(file,0,"ID",field)=

 +17      ;        D EN^DDIOL(("   "_$$IDCP^ICPTID(+Y,field)),"","?0")

 +18      ;                       

IDCP(Y,X) ; CPT/HCPCS Identifiers (versioned)

 +1        NEW FLD,MSG,CODE

           SET FLD=+($GET(X))

           SET Y=+($GET(Y))

           if +FLD'>0

               QUIT ""

           if +Y'>0

               QUIT ""

 +2        if '$DATA(DT)

               SET DT=$$DT^XLFDT

           IF '$DATA(ICPTVDT)

               NEW ICPTVDT

               SET ICPTVDT=DT

 +3        SET MSG=$$MSG^ICPTSUPT($GET(ICPTVDT),1)

           SET CODE=$PIECE($GET(^ICPT(+Y,0)),U,1)

 +4        IF FLD=2

               SET X=$$VSTCP^ICPTCOD(+Y,$GET(ICPTVDT))_$SELECT($LENGTH(MSG):("  ("_MSG_")"),1:"")

               QUIT X

 +5        IF FLD=5

               SET X=$$STA(+($$STATCHK^ICPTAPIU(CODE,$GET(ICPTVDT))))

               QUIT X

 +6        IF FLD=50!(FLD=60)!(FLD=61)!(FLD=62)

               QUIT ""

 +7        SET X=$$GET1^DIQ(81,(+($GET(Y))_","),FLD)

 +8        QUIT X

IDCPS(Y)  ; CPT/HCPCS Identifiers (versioned - short)

 +1        NEW ICID,MSG,CODE,ST,X

           SET Y=+($GET(Y))

           if +Y'>0

               QUIT ""

 +2        if '$DATA(DT)

               SET DT=$$DT^XLFDT

           IF '$DATA(ICPTVDT)

               NEW ICPTVDT

               SET ICPTVDT=DT

 +3        SET MSG=$$MSG^ICPTSUPT($GET(ICPTVDT),1)

           if MSG["CODE "

               SET MSG="Text may be inaccurate"

 +4        SET CODE=$PIECE($GET(^ICPT(+Y,0)),U,1)

 +5        SET ICID=$$VSTCP^ICPTCOD(+Y,$GET(ICPTVDT))

           if $LENGTH(MSG)

               SET ICID=ICID_"  ("_MSG_")"

 +6        SET ST=$$STA(+($$STATCHK^ICPTAPIU(CODE,$GET(ICPTVDT))))

 +7        if $LENGTH(ST)

               SET ICID=ICID_$SELECT('$LENGTH(MSG):" ",1:"")_" "_ST

 +8        FOR 

               if $EXTRACT(ICID,1)'=" "

                   QUIT 

               SET ICID=$EXTRACT(ICID,2,$LENGTH(ICID))

 +9        SET Y=ICID

 +10       QUIT Y

IDMD(Y,X) ; CPT Modifier Identifiers (versioned)

 +1        NEW FLD,MSG,CODE

           SET FLD=+($GET(X))

           SET Y=+($GET(Y))

           if +FLD'>0

               QUIT ""

           if +Y'>0

               QUIT ""

 +2        if '$DATA(DT)

               SET DT=$$DT^XLFDT

           IF '$DATA(ICPTVDT)

               NEW ICPTVDT

               SET ICPTVDT=DT

 +3        SET MSG=$$MSG^ICPTSUPT($GET(ICPTVDT),1)

 +4        IF FLD=.02

               SET X=$$VSTCM^ICPTMOD(+Y,$GET(ICPTVDT))_$SELECT($LENGTH(MSG):("  ("_MSG_")"),1:"")

               QUIT X

 +5        IF FLD=5

               Begin DoDot:1

 +6                NEW VD,I

                   SET VD=$ORDER(^DIC(81.3,+Y,60,"B"," "),-1)

 +7                SET I=+($ORDER(^DIC(81.3,+Y,60,"B",+VD," "),-1))

 +8                SET X=$$STA(+($PIECE($GET(^DIC(81.3,+Y,60,+I,0)),U,2)))

               End DoDot:1

               QUIT X

 +9        IF FLD=10!(FLD=50)!(FLD=60)!(FLD=61)!(FLD=62)

               QUIT ""

 +10       SET X=$$GET1^DIQ(81.3,(+($GET(Y))_","),FLD)

 +11       QUIT X

IDMDS(Y)  ; CPT Modifier Identifiers (versioned - short)

 +1        NEW ICID,MSG,CODE,ST,X,VD,VI

           SET Y=+($GET(Y))

           if +Y'>0

               QUIT ""

 +2        if '$DATA(DT)

               SET DT=$$DT^XLFDT

           IF '$DATA(ICPTVDT)

               NEW ICPTVDT

               SET ICPTVDT=DT

 +3        SET MSG=$$MSG^ICPTSUPT($GET(ICPTVDT),1)

           if MSG["CODE "

               SET MSG="Text may be inaccurate"

 +4        SET ICID=$$VSTCM^ICPTMOD(+Y,$GET(ICPTVDT))

           if $LENGTH(MSG)

               SET ICID=ICID_"  ("_MSG_")"

 +5        SET VD=$ORDER(^DIC(81.3,+Y,60,"B"," "),-1)

 +6        SET VI=+($ORDER(^DIC(81.3,+Y,60,"B",+VD," "),-1))

 +7        SET ST=$$STA(+($PIECE($GET(^DIC(81.3,+Y,60,+VI,0)),U,2)))

 +8        if $LENGTH(ST)

               SET ICID=ICID_$SELECT('$LENGTH(MSG):" ",1:"")_" "_ST

 +9        FOR 

               if $EXTRACT(ICID,1)'=" "

                   QUIT 

               SET ICID=$EXTRACT(ICID,2,$LENGTH(ICID))

 +10       SET Y=ICID

 +11       QUIT Y

STA(X)    ; Status

 +1        QUIT $SELECT(+($GET(X)):"",1:"INACTIVE")