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 ---[H[J[2J[HICPTID 2772 printed Nov 22, 2024@16:55:54 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")
