- 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 Feb 18, 2025@23:17:15 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")
