ICDID ;ISL/KER - ICD Identifiers ;04/21/2014
;;18.0;DRG Grouper;**12,15,57**;Oct 20, 2000;Build 1
;
; Global Variables
; None
;
; External References
; $$GET1^DIQ ICR 2056
; $$DT^XLFDT ICR 10103
; $$FMTE^XLFDT ICR 10103
;
Q
; Identifiers for ICD Diagnosis file 80
IDDX(Y,X) ; ICD Diagnosis Identifiers (versioned)
N FLD,MSG,CODE,TYPE S FLD=+($G(X)),Y=+($G(Y)) Q:+FLD'>0 "" Q:+Y'>0 ""
S TYPE=$$CSI^ICDEX(80,+Y)
I '$D(ICDVDT) N ICDVDT S ICDVDT=$$DT^XLFDT
S MSG=$$MSG^ICDEX($G(ICDVDT),,TYPE),CODE=$$CODEC^ICDEX(80,+Y)
I FLD=3 S X=$$VSTD^ICDEX(+Y,$G(ICDVDT))_$S($L(MSG):(" ("_MSG_")"),1:"") Q X
I FLD=10 S X=$$VLTD^ICDEX(+Y,$G(ICDVDT))_$S($L(MSG):(" ("_MSG_")"),1:"") Q X
I FLD=100 S X=$$STA(+($$STATCHK^ICDEX(CODE,$G(ICDVDT),TYPE))) Q X
I FLD=20!(FLD=30)!(FLD=40)!(FLD=66)!(FLD=67)!(FLD=68) Q ""
S X=$$GET1^DIQ(80,(+($G(Y))_","),FLD)
Q X
IDDXF(Y) ; ICD Diannosis Full
N CC,CODE,TYPE,SYS,EF,ICDAT,ICID,MSG,SE,ST,LDX,IEN S (IEN,Y)=+($G(Y)) Q:+IEN'>0 ""
S (SYS,TYPE)=$$CSI^ICDEX(80,+IEN),TYPE=$S(TYPE=1:"ICD-9 ",TYPE=30:"ICD-10",1:"")
S CODE=$$CODEC^ICDEX(80,+IEN) I '$D(ICDVDT) N ICDVDT S ICDVDT=$$DT^XLFDT
S ICDAT=$$ICDDX^ICDEX(IEN,$G(ICDVDT),,"I",1) S MSG=$$MSG^ICDEX($G(ICDVDT),,TYPE) S:MSG["CODE " MSG="Text may be inaccurate"
S ICID=$$UP($P(ICDAT,"^",4)),LDX="" S:ICID'=""&(TYPE'="") ICID=TYPE_" "_CODE_" "_ICID
I ICID="",$P($$UP(ICDAT),"^",2)["VA LOCAL CODE" S LDX=$$VSTD^ICDEX(+IEN,9990101) I $L(LDX) D
. S:'$L(TYPE) ICID=CODE_" "_LDX S:$L(TYPE) ICID=TYPE_" "_CODE_" "_LDX
. S:$P(ICDAT,"^",7)'>0 MSG="Local code, do not use"
S:$L(MSG)&($L(ICID)) ICID=ICID_" ("_MSG_")"
S EF="",ST=$P(ICDAT,"^",10) S:+ST'>0 EF=$P(ICDAT,"^",12)
S:+ST>0 EF=$P(ICDAT,"^",17) S ST=+ST
I ST'>0,'$L(EF) S EF=$$LS^ICDEX(80,+IEN,9990101,1),ST=+($P(EF,"^",1)),EF=+($P(EF,"^",2))
S SE=$$SF(80,IEN,ICDVDT),CC=$$CC(+$P(ICDAT,"^",19)) S:$L(CC) ICID=ICID_$S('$L(MSG):" ",1:"")_" ("_CC_")"
S:$L(SE) ICID=ICID_$S('$L(MSG)&('$L(CC)):" ",1:"")_" "_SE
S Y=$$TML(ICID)
Q Y
IDDXS(Y) ; ICD Diagnosis Identifiers (versioned - short)
N ICID,ICDAT,MSG,CODE,SYS,TYPE,ST,IEN,CC,X S (IEN,Y)=+($G(Y)) Q:+Y'>0 ""
S (SYS,TYPE)=$$CSI^ICDEX(80,+IEN) I '$D(ICDVDT) N ICDVDT S ICDVDT=$$DT^XLFDT
S MSG=$$MSG^ICDEX($G(ICDVDT),,TYPE) S:MSG["CODE " MSG="Text may be inaccurate"
S CODE=$$CODEC^ICDEX(80,+IEN),ICID=$$VSTD^ICDEX(+Y,$G(ICDVDT))
S:$L(MSG) ICID=ICID_" ("_MSG_")"
S ST=$$STA(+($$STATCHK^ICDEX(CODE,$G(ICDVDT),TYPE)))
S CC=+$P($$ICDDX^ICDEX(IEN,$G(ICDVDT),,"I",1),"^",19),CC=$$CC(+CC)
S:$L(CC) ICID=ICID_$S('$L(MSG):" ",1:"")_" ("_CC_")"
S:$L(ST) ICID=ICID_$S('$L(MSG)&('$L(CC)):" ",1:"")_" "_ST
F Q:$E(ICID,1)'=" " S ICID=$E(ICID,2,$L(ICID))
S Y=ICID
Q Y
;
; Identifiers for ICD Procedure file 80.1
IDOP(Y,X) ; ICD Procedure Identifiers (versioned)
N FLD,MSG,CODE S FLD=+($G(X)),Y=+($G(Y)) Q:+FLD'>0 "" Q:+Y'>0 ""
S TYPE=$$CSI^ICDEX(80.1,+IEN)
I '$D(ICDVDT) N ICDVDT S ICDVDT=$$DT^XLFDT
S MSG=$$MSG^ICDEX($G(ICDVDT),,TYPE),CODE=$$CODEC^ICDEX(80.1,+IEN)
I FLD=4 S X=$$VSTP^ICDEX(+Y,$G(ICDVDT))_$S($L(MSG):(" ("_MSG_")"),1:"") Q X
I FLD=10 S X=$$VLTP^ICDEX(+Y,$G(ICDVDT))_$S($L(MSG):(" ("_MSG_")"),1:"") Q X
I FLD=100 S X=$$STA(+($$STATCHK^ICDEX(CODE,$G(ICDVDT),TYPE))) Q X
I FLD=7!(FLD=66)!(FLD=67)!(FLD=68) Q ""
S X=$$GET1^DIQ(80.1,(+($G(Y))_","),FLD)
Q X
IDOPF(Y) ; ICD Procedure Full
N CODE,EF,IEN,ICDAT,ICID,MSG,SE,ST,LOP,SYS,TYPE,LHE,LHI,LHN,LST S (IEN,Y)=+($G(Y)) Q:+IEN'>0 ""
S CODE=$$CODEC^ICDEX(80.1,+IEN)
S (SYS,TYPE)=$$CSI^ICDEX(80.1,+IEN) S TYPE=$S(TYPE=2:"ICD-9 ",TYPE=31:"ICD-10",1:"") I '$D(ICDVDT) N ICDVDT S ICDVDT=$$DT^XLFDT
S ICDAT=$$ICDOP^ICDEX(IEN,ICDVDT,,"I",1),MSG=$$MSG^ICDEX($G(ICDVDT),,TYPE) S:MSG["CODE " MSG="Text may be inaccurate"
S ICID=$$UP($P(ICDAT,"^",5)),LOP="" S:ICID'=""&(TYPE'="") ICID=TYPE_" "_CODE_" "_ICID
I ICID="",$P($$UP(ICDAT),"^",2)["VA LOCAL CODE" S LOP=$$VSTP^ICDEX(+IEN,9990101) I $L(LOP) D
. S:'$L(TYPE) ICID=CODE_" "_LOP S:$L(TYPE) ICID=TYPE_" "_CODE_" "_LOP
. S:$P(ICDAT,"^",10)'>0 MSG="Local code, do not use"
S:$L(MSG)&($L(ICID)) ICID=ICID_" ("_MSG_")"
S EF="",ST=$P(ICDAT,"^",10) S:+ST'>0 EF=$P(ICDAT,"^",12) S:+ST>0 EF=$P(ICDAT,"^",13) S ST=+ST
I ST'>0,'$L(EF) S EF=$$LS^ICDEX(80.1,+IEN,9990101,1),ST=+($P(EF,"^",1)),EF=+($P(EF,"^",2))
S SE=$$SF(80.1,IEN,ICDVDT) S:$L(SE) ICID=ICID_$S('$L(MSG):" ",1:"")_" "_SE S Y=$$TML(ICID)
Q Y
IDOPS(Y) ; ICD Procedure Identifiers (versioned - short)
N ICID,MSG,CODE,LHE,LHI,LHN,LST,TYPE,ST,X S Y=+($G(Y)) Q:+Y'>0 "" I '$D(ICDVDT) N ICDVDT S ICDVDT=$$DT^XLFDT
S TYPE=$$CSI^ICDEX(80.1,+IEN),MSG=$$MSG^ICDEX($G(ICDVDT),,TYPE) S:MSG["CODE " MSG="Text may be inaccurate"
S CODE=$$CODEC^ICDEX(80.1,+IEN),ICID=$$VSTP^ICDEX(+Y,$G(ICDVDT)) S:$L(MSG) ICID=ICID_" ("_MSG_")"
S ST=$$STA(+($$STATCHK^ICDEX(CODE,$G(ICDVDT),TYPE)))
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
;
; Identifiers for DRG file 80.2
IDDG(Y,X) ; DRG Identifiers (versioned)
N FLD,MSG S FLD=+($G(X)),Y=+($G(Y)) Q:+FLD'>0 "" Q:+Y'>0 ""
I '$D(ICDVDT) N ICDVDT S ICDVDT=$$DT^XLFDT
S MSG=$$MSG^ICDEX($G(ICDVDT)) I FLD=1 D Q X
. N DRG D VLTDR^ICDGTDRG(+Y,$G(ICDVDT),.DRG)
. S X=$G(DRG(1)) S:$L(MSG) X=X_" ("_MSG_")"
I FLD=15 D Q X
. N VD,I,ST S VD=$O(^ICD(+Y,66,"B"," "),-1)
. S I=$O(^ICD(+Y,66,"B",+VD," "),-1),X=$$STA(+($P($G(^ICD(+Y,66,+I,0)),"^",3)))
I FLD=20!(FLD=30)!(FLD=66)!(FLD=68) Q ""
S X=$$GET1^DIQ(80.2,(+($G(Y))_","),FLD)
Q X
IDDGS(Y) ; DRG Identifiers (versioned - Short)
N MSG,X,ICDRG,ICID,VD,I,ST S Y=+($G(Y)) Q:+Y'>0 ""
I '$D(ICDVDT) N ICDVDT S ICDVDT=$$DT^XLFDT
S MSG=$$MSG^ICDEX($G(ICDVDT)) S:MSG["CODE " MSG="Text may be inaccurate"
D VLTDR^ICDGTDRG(+Y,$G(ICDVDT),.ICDRG)
S ICID=$G(ICDRG(1)) S:$L(MSG) ICID=ICID_" ("_MSG_")"
S VD=$O(^ICD(+Y,66,"B"," "),-1)
S I=$O(^ICD(+Y,66,"B",+VD," "),-1)
S ST=$$STA(+($P($G(^ICD(+Y,66,+I,0)),"^",3)))
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
;
; Miscellaneous
STA(X) ; Format Status
Q $S(+($G(X)):"",1:"INACTIVE")
STED(X) ; Format Inactive Flag (Status) and Effective Date
N ST,ED S ST=$P(X,"^",1) Q:+ST>0 "" S ED=$P(X,"^",2) S:ED'?7N ED="" S:$L(ED) ED=$TR($$FMTE^XLFDT(ED,"5DZ"),"@"," ")
S X="Inactive" S:$L(ED)=10 X=X_" "_ED
Q X
SF(X,Y,Z) ; Status Flag
N FI,RT,EF,IE,HIS,STA,EFF S FI=+($G(X)) Q:"^80^80.1^"'[("^"_FI_"^") ""
S RT=$S(FI=80:$$ROOT^ICDEX(80),FI=80.1:$$ROOT^ICDEX(80.1),1:"") Q:'$L(RT) ""
S IE=+($G(Y)) Q:+Y'>0 "" Q:'$D(@(RT_IE_",0)")) "" S EF=$G(Z) Q:EF'?7N ""
S EFF=$O(@(RT_IE_",66,""B"","_(EF+.000009)_")"),-1)
I EFF'?7N D Q X
. S X="" S EFF=$O(@(RT_IE_",66,""B"","_EF_")")) I EFF?7N D
. . N HIS,STA S HIS=$O(@(RT_IE_",66,""B"","_EFF_","" "")"),-1) Q:+HIS'>0
. . S STA=$G(@(RT_IE_",66,"_HIS_",0)"),-1)
. . I $P(STA,"^",2)>0 S X="(Pending "_$TR($$FMTE^XLFDT(EFF,"5DZ"),"@"," ")_")"
S HIS=$O(@(RT_IE_",66,""B"","_EFF_","" "")"),-1) Q:+HIS'>0 ""
S STA=$G(@(RT_IE_",66,"_HIS_",0)"),-1)
I $P(STA,"^",2)'>0 D Q X
. S X="(Inactive "_$TR($$FMTE^XLFDT(EFF,"5DZ"),"@"," ")_")"
Q ""
CC(X) ; Format CC
Q $S(+($G(X))=1:"C/C",+($G(X))=2:"Major C/C",1:"")
TML(X) ; Trim Leading Spaces
S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
Q X
UP(X) ; Uppercase
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICDID 7536 printed Dec 13, 2024@01:50:53 Page 2
ICDID ;ISL/KER - ICD Identifiers ;04/21/2014
+1 ;;18.0;DRG Grouper;**12,15,57**;Oct 20, 2000;Build 1
+2 ;
+3 ; Global Variables
+4 ; None
+5 ;
+6 ; External References
+7 ; $$GET1^DIQ ICR 2056
+8 ; $$DT^XLFDT ICR 10103
+9 ; $$FMTE^XLFDT ICR 10103
+10 ;
+11 QUIT
+12 ; Identifiers for ICD Diagnosis file 80
IDDX(Y,X) ; ICD Diagnosis Identifiers (versioned)
+1 NEW FLD,MSG,CODE,TYPE
SET FLD=+($GET(X))
SET Y=+($GET(Y))
if +FLD'>0
QUIT ""
if +Y'>0
QUIT ""
+2 SET TYPE=$$CSI^ICDEX(80,+Y)
+3 IF '$DATA(ICDVDT)
NEW ICDVDT
SET ICDVDT=$$DT^XLFDT
+4 SET MSG=$$MSG^ICDEX($GET(ICDVDT),,TYPE)
SET CODE=$$CODEC^ICDEX(80,+Y)
+5 IF FLD=3
SET X=$$VSTD^ICDEX(+Y,$GET(ICDVDT))_$SELECT($LENGTH(MSG):(" ("_MSG_")"),1:"")
QUIT X
+6 IF FLD=10
SET X=$$VLTD^ICDEX(+Y,$GET(ICDVDT))_$SELECT($LENGTH(MSG):(" ("_MSG_")"),1:"")
QUIT X
+7 IF FLD=100
SET X=$$STA(+($$STATCHK^ICDEX(CODE,$GET(ICDVDT),TYPE)))
QUIT X
+8 IF FLD=20!(FLD=30)!(FLD=40)!(FLD=66)!(FLD=67)!(FLD=68)
QUIT ""
+9 SET X=$$GET1^DIQ(80,(+($GET(Y))_","),FLD)
+10 QUIT X
IDDXF(Y) ; ICD Diannosis Full
+1 NEW CC,CODE,TYPE,SYS,EF,ICDAT,ICID,MSG,SE,ST,LDX,IEN
SET (IEN,Y)=+($GET(Y))
if +IEN'>0
QUIT ""
+2 SET (SYS,TYPE)=$$CSI^ICDEX(80,+IEN)
SET TYPE=$SELECT(TYPE=1:"ICD-9 ",TYPE=30:"ICD-10",1:"")
+3 SET CODE=$$CODEC^ICDEX(80,+IEN)
IF '$DATA(ICDVDT)
NEW ICDVDT
SET ICDVDT=$$DT^XLFDT
+4 SET ICDAT=$$ICDDX^ICDEX(IEN,$GET(ICDVDT),,"I",1)
SET MSG=$$MSG^ICDEX($GET(ICDVDT),,TYPE)
if MSG["CODE "
SET MSG="Text may be inaccurate"
+5 SET ICID=$$UP($PIECE(ICDAT,"^",4))
SET LDX=""
if ICID'=""&(TYPE'="")
SET ICID=TYPE_" "_CODE_" "_ICID
+6 IF ICID=""
IF $PIECE($$UP(ICDAT),"^",2)["VA LOCAL CODE"
SET LDX=$$VSTD^ICDEX(+IEN,9990101)
IF $LENGTH(LDX)
Begin DoDot:1
+7 if '$LENGTH(TYPE)
SET ICID=CODE_" "_LDX
if $LENGTH(TYPE)
SET ICID=TYPE_" "_CODE_" "_LDX
+8 if $PIECE(ICDAT,"^",7)'>0
SET MSG="Local code, do not use"
End DoDot:1
+9 if $LENGTH(MSG)&($LENGTH(ICID))
SET ICID=ICID_" ("_MSG_")"
+10 SET EF=""
SET ST=$PIECE(ICDAT,"^",10)
if +ST'>0
SET EF=$PIECE(ICDAT,"^",12)
+11 if +ST>0
SET EF=$PIECE(ICDAT,"^",17)
SET ST=+ST
+12 IF ST'>0
IF '$LENGTH(EF)
SET EF=$$LS^ICDEX(80,+IEN,9990101,1)
SET ST=+($PIECE(EF,"^",1))
SET EF=+($PIECE(EF,"^",2))
+13 SET SE=$$SF(80,IEN,ICDVDT)
SET CC=$$CC(+$PIECE(ICDAT,"^",19))
if $LENGTH(CC)
SET ICID=ICID_$SELECT('$LENGTH(MSG):" ",1:"")_" ("_CC_")"
+14 if $LENGTH(SE)
SET ICID=ICID_$SELECT('$LENGTH(MSG)&('$LENGTH(CC)):" ",1:"")_" "_SE
+15 SET Y=$$TML(ICID)
+16 QUIT Y
IDDXS(Y) ; ICD Diagnosis Identifiers (versioned - short)
+1 NEW ICID,ICDAT,MSG,CODE,SYS,TYPE,ST,IEN,CC,X
SET (IEN,Y)=+($GET(Y))
if +Y'>0
QUIT ""
+2 SET (SYS,TYPE)=$$CSI^ICDEX(80,+IEN)
IF '$DATA(ICDVDT)
NEW ICDVDT
SET ICDVDT=$$DT^XLFDT
+3 SET MSG=$$MSG^ICDEX($GET(ICDVDT),,TYPE)
if MSG["CODE "
SET MSG="Text may be inaccurate"
+4 SET CODE=$$CODEC^ICDEX(80,+IEN)
SET ICID=$$VSTD^ICDEX(+Y,$GET(ICDVDT))
+5 if $LENGTH(MSG)
SET ICID=ICID_" ("_MSG_")"
+6 SET ST=$$STA(+($$STATCHK^ICDEX(CODE,$GET(ICDVDT),TYPE)))
+7 SET CC=+$PIECE($$ICDDX^ICDEX(IEN,$GET(ICDVDT),,"I",1),"^",19)
SET CC=$$CC(+CC)
+8 if $LENGTH(CC)
SET ICID=ICID_$SELECT('$LENGTH(MSG):" ",1:"")_" ("_CC_")"
+9 if $LENGTH(ST)
SET ICID=ICID_$SELECT('$LENGTH(MSG)&('$LENGTH(CC)):" ",1:"")_" "_ST
+10 FOR
if $EXTRACT(ICID,1)'=" "
QUIT
SET ICID=$EXTRACT(ICID,2,$LENGTH(ICID))
+11 SET Y=ICID
+12 QUIT Y
+13 ;
+14 ; Identifiers for ICD Procedure file 80.1
IDOP(Y,X) ; ICD Procedure Identifiers (versioned)
+1 NEW FLD,MSG,CODE
SET FLD=+($GET(X))
SET Y=+($GET(Y))
if +FLD'>0
QUIT ""
if +Y'>0
QUIT ""
+2 SET TYPE=$$CSI^ICDEX(80.1,+IEN)
+3 IF '$DATA(ICDVDT)
NEW ICDVDT
SET ICDVDT=$$DT^XLFDT
+4 SET MSG=$$MSG^ICDEX($GET(ICDVDT),,TYPE)
SET CODE=$$CODEC^ICDEX(80.1,+IEN)
+5 IF FLD=4
SET X=$$VSTP^ICDEX(+Y,$GET(ICDVDT))_$SELECT($LENGTH(MSG):(" ("_MSG_")"),1:"")
QUIT X
+6 IF FLD=10
SET X=$$VLTP^ICDEX(+Y,$GET(ICDVDT))_$SELECT($LENGTH(MSG):(" ("_MSG_")"),1:"")
QUIT X
+7 IF FLD=100
SET X=$$STA(+($$STATCHK^ICDEX(CODE,$GET(ICDVDT),TYPE)))
QUIT X
+8 IF FLD=7!(FLD=66)!(FLD=67)!(FLD=68)
QUIT ""
+9 SET X=$$GET1^DIQ(80.1,(+($GET(Y))_","),FLD)
+10 QUIT X
IDOPF(Y) ; ICD Procedure Full
+1 NEW CODE,EF,IEN,ICDAT,ICID,MSG,SE,ST,LOP,SYS,TYPE,LHE,LHI,LHN,LST
SET (IEN,Y)=+($GET(Y))
if +IEN'>0
QUIT ""
+2 SET CODE=$$CODEC^ICDEX(80.1,+IEN)
+3 SET (SYS,TYPE)=$$CSI^ICDEX(80.1,+IEN)
SET TYPE=$SELECT(TYPE=2:"ICD-9 ",TYPE=31:"ICD-10",1:"")
IF '$DATA(ICDVDT)
NEW ICDVDT
SET ICDVDT=$$DT^XLFDT
+4 SET ICDAT=$$ICDOP^ICDEX(IEN,ICDVDT,,"I",1)
SET MSG=$$MSG^ICDEX($GET(ICDVDT),,TYPE)
if MSG["CODE "
SET MSG="Text may be inaccurate"
+5 SET ICID=$$UP($PIECE(ICDAT,"^",5))
SET LOP=""
if ICID'=""&(TYPE'="")
SET ICID=TYPE_" "_CODE_" "_ICID
+6 IF ICID=""
IF $PIECE($$UP(ICDAT),"^",2)["VA LOCAL CODE"
SET LOP=$$VSTP^ICDEX(+IEN,9990101)
IF $LENGTH(LOP)
Begin DoDot:1
+7 if '$LENGTH(TYPE)
SET ICID=CODE_" "_LOP
if $LENGTH(TYPE)
SET ICID=TYPE_" "_CODE_" "_LOP
+8 if $PIECE(ICDAT,"^",10)'>0
SET MSG="Local code, do not use"
End DoDot:1
+9 if $LENGTH(MSG)&($LENGTH(ICID))
SET ICID=ICID_" ("_MSG_")"
+10 SET EF=""
SET ST=$PIECE(ICDAT,"^",10)
if +ST'>0
SET EF=$PIECE(ICDAT,"^",12)
if +ST>0
SET EF=$PIECE(ICDAT,"^",13)
SET ST=+ST
+11 IF ST'>0
IF '$LENGTH(EF)
SET EF=$$LS^ICDEX(80.1,+IEN,9990101,1)
SET ST=+($PIECE(EF,"^",1))
SET EF=+($PIECE(EF,"^",2))
+12 SET SE=$$SF(80.1,IEN,ICDVDT)
if $LENGTH(SE)
SET ICID=ICID_$SELECT('$LENGTH(MSG):" ",1:"")_" "_SE
SET Y=$$TML(ICID)
+13 QUIT Y
IDOPS(Y) ; ICD Procedure Identifiers (versioned - short)
+1 NEW ICID,MSG,CODE,LHE,LHI,LHN,LST,TYPE,ST,X
SET Y=+($GET(Y))
if +Y'>0
QUIT ""
IF '$DATA(ICDVDT)
NEW ICDVDT
SET ICDVDT=$$DT^XLFDT
+2 SET TYPE=$$CSI^ICDEX(80.1,+IEN)
SET MSG=$$MSG^ICDEX($GET(ICDVDT),,TYPE)
if MSG["CODE "
SET MSG="Text may be inaccurate"
+3 SET CODE=$$CODEC^ICDEX(80.1,+IEN)
SET ICID=$$VSTP^ICDEX(+Y,$GET(ICDVDT))
if $LENGTH(MSG)
SET ICID=ICID_" ("_MSG_")"
+4 SET ST=$$STA(+($$STATCHK^ICDEX(CODE,$GET(ICDVDT),TYPE)))
+5 if $LENGTH(ST)
SET ICID=ICID_$SELECT('$LENGTH(MSG):" ",1:"")_" "_ST
+6 FOR
if $EXTRACT(ICID,1)'=" "
QUIT
SET ICID=$EXTRACT(ICID,2,$LENGTH(ICID))
+7 SET Y=ICID
+8 QUIT Y
+9 ;
+10 ; Identifiers for DRG file 80.2
IDDG(Y,X) ; DRG Identifiers (versioned)
+1 NEW FLD,MSG
SET FLD=+($GET(X))
SET Y=+($GET(Y))
if +FLD'>0
QUIT ""
if +Y'>0
QUIT ""
+2 IF '$DATA(ICDVDT)
NEW ICDVDT
SET ICDVDT=$$DT^XLFDT
+3 SET MSG=$$MSG^ICDEX($GET(ICDVDT))
IF FLD=1
Begin DoDot:1
+4 NEW DRG
DO VLTDR^ICDGTDRG(+Y,$GET(ICDVDT),.DRG)
+5 SET X=$GET(DRG(1))
if $LENGTH(MSG)
SET X=X_" ("_MSG_")"
End DoDot:1
QUIT X
+6 IF FLD=15
Begin DoDot:1
+7 NEW VD,I,ST
SET VD=$ORDER(^ICD(+Y,66,"B"," "),-1)
+8 SET I=$ORDER(^ICD(+Y,66,"B",+VD," "),-1)
SET X=$$STA(+($PIECE($GET(^ICD(+Y,66,+I,0)),"^",3)))
End DoDot:1
QUIT X
+9 IF FLD=20!(FLD=30)!(FLD=66)!(FLD=68)
QUIT ""
+10 SET X=$$GET1^DIQ(80.2,(+($GET(Y))_","),FLD)
+11 QUIT X
IDDGS(Y) ; DRG Identifiers (versioned - Short)
+1 NEW MSG,X,ICDRG,ICID,VD,I,ST
SET Y=+($GET(Y))
if +Y'>0
QUIT ""
+2 IF '$DATA(ICDVDT)
NEW ICDVDT
SET ICDVDT=$$DT^XLFDT
+3 SET MSG=$$MSG^ICDEX($GET(ICDVDT))
if MSG["CODE "
SET MSG="Text may be inaccurate"
+4 DO VLTDR^ICDGTDRG(+Y,$GET(ICDVDT),.ICDRG)
+5 SET ICID=$GET(ICDRG(1))
if $LENGTH(MSG)
SET ICID=ICID_" ("_MSG_")"
+6 SET VD=$ORDER(^ICD(+Y,66,"B"," "),-1)
+7 SET I=$ORDER(^ICD(+Y,66,"B",+VD," "),-1)
+8 SET ST=$$STA(+($PIECE($GET(^ICD(+Y,66,+I,0)),"^",3)))
+9 if $LENGTH(ST)
SET ICID=ICID_$SELECT('$LENGTH(MSG):" ",1:"")_" "_ST
+10 FOR
if $EXTRACT(ICID,1)'=" "
QUIT
SET ICID=$EXTRACT(ICID,2,$LENGTH(ICID))
+11 SET Y=ICID
+12 QUIT Y
+13 ;
+14 ; Miscellaneous
STA(X) ; Format Status
+1 QUIT $SELECT(+($GET(X)):"",1:"INACTIVE")
STED(X) ; Format Inactive Flag (Status) and Effective Date
+1 NEW ST,ED
SET ST=$PIECE(X,"^",1)
if +ST>0
QUIT ""
SET ED=$PIECE(X,"^",2)
if ED'?7N
SET ED=""
if $LENGTH(ED)
SET ED=$TRANSLATE($$FMTE^XLFDT(ED,"5DZ"),"@"," ")
+2 SET X="Inactive"
if $LENGTH(ED)=10
SET X=X_" "_ED
+3 QUIT X
SF(X,Y,Z) ; Status Flag
+1 NEW FI,RT,EF,IE,HIS,STA,EFF
SET FI=+($GET(X))
if "^80^80.1^"'[("^"_FI_"^")
QUIT ""
+2 SET RT=$SELECT(FI=80:$$ROOT^ICDEX(80),FI=80.1:$$ROOT^ICDEX(80.1),1:"")
if '$LENGTH(RT)
QUIT ""
+3 SET IE=+($GET(Y))
if +Y'>0
QUIT ""
if '$DATA(@(RT_IE_",0)"))
QUIT ""
SET EF=$GET(Z)
if EF'?7N
QUIT ""
+4 SET EFF=$ORDER(@(RT_IE_",66,""B"","_(EF+.000009)_")"),-1)
+5 IF EFF'?7N
Begin DoDot:1
+6 SET X=""
SET EFF=$ORDER(@(RT_IE_",66,""B"","_EF_")"))
IF EFF?7N
Begin DoDot:2
+7 NEW HIS,STA
SET HIS=$ORDER(@(RT_IE_",66,""B"","_EFF_","" "")"),-1)
if +HIS'>0
QUIT
+8 SET STA=$GET(@(RT_IE_",66,"_HIS_",0)"),-1)
+9 IF $PIECE(STA,"^",2)>0
SET X="(Pending "_$TRANSLATE($$FMTE^XLFDT(EFF,"5DZ"),"@"," ")_")"
End DoDot:2
End DoDot:1
QUIT X
+10 SET HIS=$ORDER(@(RT_IE_",66,""B"","_EFF_","" "")"),-1)
if +HIS'>0
QUIT ""
+11 SET STA=$GET(@(RT_IE_",66,"_HIS_",0)"),-1)
+12 IF $PIECE(STA,"^",2)'>0
Begin DoDot:1
+13 SET X="(Inactive "_$TRANSLATE($$FMTE^XLFDT(EFF,"5DZ"),"@"," ")_")"
End DoDot:1
QUIT X
+14 QUIT ""
CC(X) ; Format CC
+1 QUIT $SELECT(+($GET(X))=1:"C/C",+($GET(X))=2:"Major C/C",1:"")
TML(X) ; Trim Leading Spaces
+1 SET X=$GET(X)
FOR
if $EXTRACT(X,1)'=" "
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+2 QUIT X
UP(X) ; Uppercase
+1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
