ICDIDX2 ;DLS/DEK - MUMPS Cross Reference Routine for History ;04/21/2014
;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 1
;
; Global Variables
; None
;
; External References
; None
;
; Common Variables used:
;
; ICDCOD ICD Code from Global
; ICDCODX ICD Code passed in (X)
; ICDEFF Effective Date
; ICDSTA Status
; ICDNOD Global Node (to reduce Global hits)
; DA IEN file 80, 80.1, 80.066 or 80.166
; ICDIEN,DA(1) IEN of file 80 or 80.1
; ICDHIS IEN of file 80.066 or 80.166
; X Data passed in to be indexed
;
Q
SAHC(ICD) ; Code .01 ACT1 Set
N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDCODX,ICDHIS,ICDIEN,ICDSYS,RT,EXC
S RT=$$RT($G(ICD)) Q:'$L(RT) S EXC=$$EXC(+($G(DA)),RT) Q:+EXC'>0
S ICDCODX=$G(X) Q:'$L(ICDCODX) S ICDIEN=+($G(DA)) Q:+ICDIEN'>0
Q:'$D(@(RT_+ICDIEN_",66)"))
S ICDHIS=0 F S ICDHIS=$O(@(RT_+ICDIEN_",66,"_ICDHIS_")")) Q:+ICDHIS=0 D
. N DA,ICDSYS,X S DA=+ICDHIS,DA(1)=+ICDIEN D HDC
. S ICDCOD=ICDCODX Q:'$L($G(ICDCOD))
. Q:'$L($G(ICDEFF)) Q:'$L($G(ICDSTA)) K ICDSYS D SHIS
. S ICDSYS=+($P($G(@(RT_+($G(DA(1)))_",1)")),"^",1)) D:+ICDSYS>0 SHIS
Q
KAHC(ICD) ; Code .01 ACT1 Kill
N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDCODX,ICDHIS,ICDIEN,ICDSYS,RT
S RT=$$RT($G(ICD)) Q:'$L(RT) S ICDCODX=$G(X) Q:'$L(ICDCODX)
S ICDIEN=+($G(DA)) Q:+ICDIEN'>0 Q:'$D(@(RT_+ICDIEN_",66)"))
S ICDHIS=0 F S ICDHIS=$O(@(RT_+ICDIEN_",66,"_ICDHIS_")")) Q:+ICDHIS=0 D
. N DA,X S DA=+ICDHIS,DA(1)=+ICDIEN D HDC
. S ICDCOD=ICDCODX Q:'$L($G(ICDCOD))
. Q:'$L($G(ICDEFF)) Q:'$L($G(ICDSTA)) K ICDSYS D KHIS
. S ICDSYS=+($P($G(@(RT_+($G(DA(1)))_",1)")),"^",1)) D:+ICDSYS>0 KHIS
Q
SAHD(ICD) ; Effective Date 66,.01 ACT2 Set
S RT=$$RT($G(ICD)) Q:'$L(RT) S EXC=$$EXC(+($G(DA(1))),RT) Q:+EXC'>0
N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDSYS
D HDC Q:'$L($G(ICDCOD)) Q:'$L($G(ICDSTA)) S ICDEFF=+($G(X)) Q:+ICDEFF=0 K ICDSYS D SHIS
S ICDSYS=+($P($G(@(RT_+($G(DA(1)))_",1)")),"^",1)) D:+ICDSYS>0 SHIS
Q
KAHD(ICD) ; Effective Date 66,.01 ACT2 Kill
N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDSYS
S RT=$$RT($G(ICD)) Q:'$L(RT) D HDC Q:'$L($G(ICDCOD)) Q:'$L($G(ICDSTA))
S ICDEFF=+($G(X)) Q:+ICDEFF=0 K ICDSYS D KHIS
S ICDSYS=+($P($G(@(RT_+($G(DA(1)))_",1)")),"^",1)) D:+ICDSYS>0 KHIS
Q
SAHS(ICD) ; Status 66,.02 ACT3 Set
N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDSYS,RT,EXC
S RT=$$RT($G(ICD)) Q:'$L(RT) S EXC=$$EXC(+($G(DA(1))),RT) Q:+EXC'>0
D HDC Q:'$L($G(ICDCOD)) Q:+ICDEFF=0
S ICDSTA=$G(X) Q:'$L(ICDSTA) K ICDSYS D SHIS
S ICDSYS=+($P($G(@(RT_+($G(DA(1)))_",1)")),"^",1)) D:+ICDSYS>0 SHIS
Q
KAHS(ICD) ; Status 66,.02 ACT3 Kill
N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDSYS,ICDSYS,RT
S RT=$$RT($G(ICD)) Q:'$L(RT)
D HDC Q:'$L($G(ICDCOD)) Q:+ICDEFF=0
S ICDSTA=$G(X) Q:'$L(ICDSTA) K ICDSYS D KHIS
S ICDSYS=+($P($G(@(RT_+($G(DA(1)))_",1)")),"^",1)) D:+ICDSYS>0 KHIS
Q
SAHCS(ICD) ; Coding System 1.1 ACT4 Set
N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDCODX,ICDHIS,ICDIEN,ICDSYS,RT,EXC
S RT=$$RT($G(ICD)) Q:'$L(RT) S EXC=$$EXC(+($G(DA)),RT) Q:+EXC'>0
S ICDSYS=$G(X) Q:'$L(ICDSYS) S ICDIEN=+($G(DA)) Q:+ICDIEN'>0
S EXC=$$EXC(DA) Q:+EXC'>0 Q:'$D(@(RT_+ICDIEN_",66)"))
S ICDHIS=0 F S ICDHIS=$O(@(RT_+ICDIEN_",66,"_ICDHIS_")")) Q:+ICDHIS=0 D
. N DA,X S DA=+ICDHIS,DA(1)=+ICDIEN D HDC
. S ICDCOD=$P($G(@(RT_+ICDIEN_",0)")),"^",1) Q:'$L($G(ICDCOD))
. Q:'$L($G(ICDEFF)) Q:'$L($G(ICDSTA)) D SHIS
Q
KAHCS(ICD) ; Coding System 1.1 ACT4 Kill
N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDCODX,ICDHIS,ICDIEN,ICDSYS,RT
S RT=$$RT($G(ICD)) Q:'$L(RT) S ICDSYS=$G(X) Q:'$L(ICDSYS)
S ICDIEN=+($G(DA)) Q:+ICDIEN'>0 Q:'$D(@(RT_+ICDIEN_",66)"))
S ICDHIS=0 F S ICDHIS=$O(@(RT_+ICDIEN_",66,"_ICDHIS_")")) Q:+ICDHIS=0 D
. N DA,X S DA=+ICDHIS,DA(1)=+ICDIEN D HDC
. S ICDCOD=$P($G(@(RT_+ICDIEN_",0)")),"^",1) Q:'$L($G(ICDCOD))
. Q:'$L($G(ICDEFF)) Q:'$L($G(ICDSTA)) D KHIS
Q
SNUM(ICD) ; Code .01 AN1 Set
N RT,EXC,NUM,SYS
S RT=$$RT($G(ICD)) Q:'$L(RT) S EXC=$$EXC(+($G(DA)),RT) Q:+EXC'>0
S SYS=+($P($G(@(RT_+DA_",1)")),"^",1)) Q:+SYS'>0
Q:'$L($G(X)) Q:+($G(DA))'>0
S NUM=$$NUM^ICDEX(X) Q:+NUM'>0
S @(RT_""""_"AN"_+SYS_""","_+NUM_","_+DA_")")=""
Q
KNUM(ICD) ; Code .01 AN1 Kill
N RT,NUM,SYS
S RT=$$RT($G(ICD)) Q:'$L(RT) S SYS=+($P($G(@(RT_+DA_",1)")),"^",1)) Q:+SYS'>0
Q:'$L($G(X)) Q:+($G(DA))'>0 S NUM=$$NUM^ICDEX(X) Q:+NUM'>0
K @(RT_""""_"AN"_+SYS_""","_+NUM_","_+DA_")")
Q
SNUM2(ICD) ; Coding System 1.1 AN2 Set
N RT,EXC,NUM,SYS,COD S SYS=+($G(X)) Q:+SYS'>0 Q:+($G(DA))'>0
S RT=$$RT($G(ICD)) Q:'$L(RT) S EXC=$$EXC(+($G(DA)),RT) Q:+EXC'>0
S COD=$P($G(@(RT_+DA_",0)")),"^",1) Q:'$L(COD)
S NUM=$$NUM^ICDEX(COD) Q:+NUM'>0
S @(RT_""""_"AN"_+SYS_""","_+NUM_","_+DA_")")=""
Q
KNUM2(ICD) ; Coding System 1.1 AN2 Kill
N RT,EXC,NUM,SYS,COD S SYS=+($G(X)) Q:+SYS'>0 Q:+($G(DA))'>0
S RT=$$RT($G(ICD)) Q:'$L(RT) S COD=$P($G(@(RT_+DA_",0)")),"^",1)
Q:'$L(COD) S NUM=$$NUM^ICDEX(COD) Q:+NUM'>0
K @(RT_""""_"AN"_+SYS_""","_+NUM_","_+DA_")")
Q
SSYS(ICD) ; Coding System - Static
Q
KSYS(ICD) ; Coding System - Static
Q
;
; Miscellaneous
HDC ; Set Common Variables (Code, Status and Effective Date)
Q:'$L($G(RT)) S (ICDCOD,ICDSTA,ICDEFF)="" Q:'$L($G(RT))
Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 Q:'$D(@(RT_+($G(DA(1)))_",66,"_+($G(DA))_",0)"))
S ICDCOD=$P($G(@(RT_+($G(DA(1)))_",0)")),"^",1),ICDNOD=$G(@(RT_+($G(DA(1)))_",66,"_+($G(DA))_",0)"))
S ICDSTA=$P(ICDNOD,"^",2),ICDEFF=$P(ICDNOD,"^",1)
Q
SHIS ; Set ^ROOT("ACT",<code>,<status>,<date>,<ien>,<history>)
; Set ^ROOT("ACTS",<sys>,<code>,<status>,<date>,<ien>,<history>)
Q:'$L($G(RT)) N EXC Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0
Q:'$D(@(RT_+($G(DA(1)))_",66,"_+($G(DA))_",0)"))
Q:'$L($G(ICDCOD)) Q:'$L($G(ICDSTA)) Q:'$L($G(ICDEFF))
S @(RT_"""ACT"","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")=""
S:+($G(ICDSYS))>0 @(RT_"""ACTS"","_+ICDSYS_","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")=""
I +($G(ICDSYS))'>0 D
. N SYS S SYS=+($P($G(@(RT_+DA(1)_",1)")),"^",1))
. S:+SYS>0 @(RT_"""ACTS"","_+SYS_","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")=""
Q
KHIS ; Kill ^ROOT("ACT",<code>,<status>,<date>,<ien>,<history>)
; Kill ^ROOT("ACTS",<sys>,<code>,<status>,<date>,<ien>,<history>)
Q:'$L($G(RT)) Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 Q:'$D(@(RT_+($G(DA(1)))_",66,"_+($G(DA))_",0)"))
Q:'$L($G(ICDCOD)) Q:'$L($G(ICDSTA)) Q:'$L($G(ICDEFF))
K @(RT_"""ACT"","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")
K:+($G(ICDSYS))>0 @(RT_"""ACTS"","_+ICDSYS_","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")
I +($G(ICDSYS))'>0 D
. N SYS S SYS=+($P($G(@(RT_+DA(1)_",1)")),"^",1))
. K:+SYS>0 @(RT_"""ACTS"","_+SYS_","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")
Q
EXC(X,Y) ; Exclude from lookup
N COD,EFF,LDS,IEN,RT S IEN=+($G(X)),RT=$G(Y) Q:+IEN'>0 0 Q:'$L(RT) 0 S COD=$P($G(@(RT_+IEN_",0)")),"^",1)
S EFF=$O(@(RT_+IEN_",66,0)")),LDS=$O(@(RT_+IEN_",68,0)")) Q:$L(COD)&(+EFF>0)&(+LDS>0) 1
Q 0
RT(X) ; Root from File #
Q $S(+($G(X))=80:$$ROOT^ICDEX(80),+($G(X))=80.1:$$ROOT^ICDEX(80.1),1:"")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICDIDX2 7459 printed Oct 16, 2024@17:51:37 Page 2
ICDIDX2 ;DLS/DEK - MUMPS Cross Reference Routine for History ;04/21/2014
+1 ;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 1
+2 ;
+3 ; Global Variables
+4 ; None
+5 ;
+6 ; External References
+7 ; None
+8 ;
+9 ; Common Variables used:
+10 ;
+11 ; ICDCOD ICD Code from Global
+12 ; ICDCODX ICD Code passed in (X)
+13 ; ICDEFF Effective Date
+14 ; ICDSTA Status
+15 ; ICDNOD Global Node (to reduce Global hits)
+16 ; DA IEN file 80, 80.1, 80.066 or 80.166
+17 ; ICDIEN,DA(1) IEN of file 80 or 80.1
+18 ; ICDHIS IEN of file 80.066 or 80.166
+19 ; X Data passed in to be indexed
+20 ;
+21 QUIT
SAHC(ICD) ; Code .01 ACT1 Set
+1 NEW ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDCODX,ICDHIS,ICDIEN,ICDSYS,RT,EXC
+2 SET RT=$$RT($GET(ICD))
if '$LENGTH(RT)
QUIT
SET EXC=$$EXC(+($GET(DA)),RT)
if +EXC'>0
QUIT
+3 SET ICDCODX=$GET(X)
if '$LENGTH(ICDCODX)
QUIT
SET ICDIEN=+($GET(DA))
if +ICDIEN'>0
QUIT
+4 if '$DATA(@(RT_+ICDIEN_",66)"))
QUIT
+5 SET ICDHIS=0
FOR
SET ICDHIS=$ORDER(@(RT_+ICDIEN_",66,"_ICDHIS_")"))
if +ICDHIS=0
QUIT
Begin DoDot:1
+6 NEW DA,ICDSYS,X
SET DA=+ICDHIS
SET DA(1)=+ICDIEN
DO HDC
+7 SET ICDCOD=ICDCODX
if '$LENGTH($GET(ICDCOD))
QUIT
+8 if '$LENGTH($GET(ICDEFF))
QUIT
if '$LENGTH($GET(ICDSTA))
QUIT
KILL ICDSYS
DO SHIS
+9 SET ICDSYS=+($PIECE($GET(@(RT_+($GET(DA(1)))_",1)")),"^",1))
if +ICDSYS>0
DO SHIS
End DoDot:1
+10 QUIT
KAHC(ICD) ; Code .01 ACT1 Kill
+1 NEW ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDCODX,ICDHIS,ICDIEN,ICDSYS,RT
+2 SET RT=$$RT($GET(ICD))
if '$LENGTH(RT)
QUIT
SET ICDCODX=$GET(X)
if '$LENGTH(ICDCODX)
QUIT
+3 SET ICDIEN=+($GET(DA))
if +ICDIEN'>0
QUIT
if '$DATA(@(RT_+ICDIEN_",66)"))
QUIT
+4 SET ICDHIS=0
FOR
SET ICDHIS=$ORDER(@(RT_+ICDIEN_",66,"_ICDHIS_")"))
if +ICDHIS=0
QUIT
Begin DoDot:1
+5 NEW DA,X
SET DA=+ICDHIS
SET DA(1)=+ICDIEN
DO HDC
+6 SET ICDCOD=ICDCODX
if '$LENGTH($GET(ICDCOD))
QUIT
+7 if '$LENGTH($GET(ICDEFF))
QUIT
if '$LENGTH($GET(ICDSTA))
QUIT
KILL ICDSYS
DO KHIS
+8 SET ICDSYS=+($PIECE($GET(@(RT_+($GET(DA(1)))_",1)")),"^",1))
if +ICDSYS>0
DO KHIS
End DoDot:1
+9 QUIT
SAHD(ICD) ; Effective Date 66,.01 ACT2 Set
+1 SET RT=$$RT($GET(ICD))
if '$LENGTH(RT)
QUIT
SET EXC=$$EXC(+($GET(DA(1))),RT)
if +EXC'>0
QUIT
+2 NEW ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDSYS
+3 DO HDC
if '$LENGTH($GET(ICDCOD))
QUIT
if '$LENGTH($GET(ICDSTA))
QUIT
SET ICDEFF=+($GET(X))
if +ICDEFF=0
QUIT
KILL ICDSYS
DO SHIS
+4 SET ICDSYS=+($PIECE($GET(@(RT_+($GET(DA(1)))_",1)")),"^",1))
if +ICDSYS>0
DO SHIS
+5 QUIT
KAHD(ICD) ; Effective Date 66,.01 ACT2 Kill
+1 NEW ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDSYS
+2 SET RT=$$RT($GET(ICD))
if '$LENGTH(RT)
QUIT
DO HDC
if '$LENGTH($GET(ICDCOD))
QUIT
if '$LENGTH($GET(ICDSTA))
QUIT
+3 SET ICDEFF=+($GET(X))
if +ICDEFF=0
QUIT
KILL ICDSYS
DO KHIS
+4 SET ICDSYS=+($PIECE($GET(@(RT_+($GET(DA(1)))_",1)")),"^",1))
if +ICDSYS>0
DO KHIS
+5 QUIT
SAHS(ICD) ; Status 66,.02 ACT3 Set
+1 NEW ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDSYS,RT,EXC
+2 SET RT=$$RT($GET(ICD))
if '$LENGTH(RT)
QUIT
SET EXC=$$EXC(+($GET(DA(1))),RT)
if +EXC'>0
QUIT
+3 DO HDC
if '$LENGTH($GET(ICDCOD))
QUIT
if +ICDEFF=0
QUIT
+4 SET ICDSTA=$GET(X)
if '$LENGTH(ICDSTA)
QUIT
KILL ICDSYS
DO SHIS
+5 SET ICDSYS=+($PIECE($GET(@(RT_+($GET(DA(1)))_",1)")),"^",1))
if +ICDSYS>0
DO SHIS
+6 QUIT
KAHS(ICD) ; Status 66,.02 ACT3 Kill
+1 NEW ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDSYS,ICDSYS,RT
+2 SET RT=$$RT($GET(ICD))
if '$LENGTH(RT)
QUIT
+3 DO HDC
if '$LENGTH($GET(ICDCOD))
QUIT
if +ICDEFF=0
QUIT
+4 SET ICDSTA=$GET(X)
if '$LENGTH(ICDSTA)
QUIT
KILL ICDSYS
DO KHIS
+5 SET ICDSYS=+($PIECE($GET(@(RT_+($GET(DA(1)))_",1)")),"^",1))
if +ICDSYS>0
DO KHIS
+6 QUIT
SAHCS(ICD) ; Coding System 1.1 ACT4 Set
+1 NEW ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDCODX,ICDHIS,ICDIEN,ICDSYS,RT,EXC
+2 SET RT=$$RT($GET(ICD))
if '$LENGTH(RT)
QUIT
SET EXC=$$EXC(+($GET(DA)),RT)
if +EXC'>0
QUIT
+3 SET ICDSYS=$GET(X)
if '$LENGTH(ICDSYS)
QUIT
SET ICDIEN=+($GET(DA))
if +ICDIEN'>0
QUIT
+4 SET EXC=$$EXC(DA)
if +EXC'>0
QUIT
if '$DATA(@(RT_+ICDIEN_",66)"))
QUIT
+5 SET ICDHIS=0
FOR
SET ICDHIS=$ORDER(@(RT_+ICDIEN_",66,"_ICDHIS_")"))
if +ICDHIS=0
QUIT
Begin DoDot:1
+6 NEW DA,X
SET DA=+ICDHIS
SET DA(1)=+ICDIEN
DO HDC
+7 SET ICDCOD=$PIECE($GET(@(RT_+ICDIEN_",0)")),"^",1)
if '$LENGTH($GET(ICDCOD))
QUIT
+8 if '$LENGTH($GET(ICDEFF))
QUIT
if '$LENGTH($GET(ICDSTA))
QUIT
DO SHIS
End DoDot:1
+9 QUIT
KAHCS(ICD) ; Coding System 1.1 ACT4 Kill
+1 NEW ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDCODX,ICDHIS,ICDIEN,ICDSYS,RT
+2 SET RT=$$RT($GET(ICD))
if '$LENGTH(RT)
QUIT
SET ICDSYS=$GET(X)
if '$LENGTH(ICDSYS)
QUIT
+3 SET ICDIEN=+($GET(DA))
if +ICDIEN'>0
QUIT
if '$DATA(@(RT_+ICDIEN_",66)"))
QUIT
+4 SET ICDHIS=0
FOR
SET ICDHIS=$ORDER(@(RT_+ICDIEN_",66,"_ICDHIS_")"))
if +ICDHIS=0
QUIT
Begin DoDot:1
+5 NEW DA,X
SET DA=+ICDHIS
SET DA(1)=+ICDIEN
DO HDC
+6 SET ICDCOD=$PIECE($GET(@(RT_+ICDIEN_",0)")),"^",1)
if '$LENGTH($GET(ICDCOD))
QUIT
+7 if '$LENGTH($GET(ICDEFF))
QUIT
if '$LENGTH($GET(ICDSTA))
QUIT
DO KHIS
End DoDot:1
+8 QUIT
SNUM(ICD) ; Code .01 AN1 Set
+1 NEW RT,EXC,NUM,SYS
+2 SET RT=$$RT($GET(ICD))
if '$LENGTH(RT)
QUIT
SET EXC=$$EXC(+($GET(DA)),RT)
if +EXC'>0
QUIT
+3 SET SYS=+($PIECE($GET(@(RT_+DA_",1)")),"^",1))
if +SYS'>0
QUIT
+4 if '$LENGTH($GET(X))
QUIT
if +($GET(DA))'>0
QUIT
+5 SET NUM=$$NUM^ICDEX(X)
if +NUM'>0
QUIT
+6 SET @(RT_""""_"AN"_+SYS_""","_+NUM_","_+DA_")")=""
+7 QUIT
KNUM(ICD) ; Code .01 AN1 Kill
+1 NEW RT,NUM,SYS
+2 SET RT=$$RT($GET(ICD))
if '$LENGTH(RT)
QUIT
SET SYS=+($PIECE($GET(@(RT_+DA_",1)")),"^",1))
if +SYS'>0
QUIT
+3 if '$LENGTH($GET(X))
QUIT
if +($GET(DA))'>0
QUIT
SET NUM=$$NUM^ICDEX(X)
if +NUM'>0
QUIT
+4 KILL @(RT_""""_"AN"_+SYS_""","_+NUM_","_+DA_")")
+5 QUIT
SNUM2(ICD) ; Coding System 1.1 AN2 Set
+1 NEW RT,EXC,NUM,SYS,COD
SET SYS=+($GET(X))
if +SYS'>0
QUIT
if +($GET(DA))'>0
QUIT
+2 SET RT=$$RT($GET(ICD))
if '$LENGTH(RT)
QUIT
SET EXC=$$EXC(+($GET(DA)),RT)
if +EXC'>0
QUIT
+3 SET COD=$PIECE($GET(@(RT_+DA_",0)")),"^",1)
if '$LENGTH(COD)
QUIT
+4 SET NUM=$$NUM^ICDEX(COD)
if +NUM'>0
QUIT
+5 SET @(RT_""""_"AN"_+SYS_""","_+NUM_","_+DA_")")=""
+6 QUIT
KNUM2(ICD) ; Coding System 1.1 AN2 Kill
+1 NEW RT,EXC,NUM,SYS,COD
SET SYS=+($GET(X))
if +SYS'>0
QUIT
if +($GET(DA))'>0
QUIT
+2 SET RT=$$RT($GET(ICD))
if '$LENGTH(RT)
QUIT
SET COD=$PIECE($GET(@(RT_+DA_",0)")),"^",1)
+3 if '$LENGTH(COD)
QUIT
SET NUM=$$NUM^ICDEX(COD)
if +NUM'>0
QUIT
+4 KILL @(RT_""""_"AN"_+SYS_""","_+NUM_","_+DA_")")
+5 QUIT
SSYS(ICD) ; Coding System - Static
+1 QUIT
KSYS(ICD) ; Coding System - Static
+1 QUIT
+2 ;
+3 ; Miscellaneous
HDC ; Set Common Variables (Code, Status and Effective Date)
+1 if '$LENGTH($GET(RT))
QUIT
SET (ICDCOD,ICDSTA,ICDEFF)=""
if '$LENGTH($GET(RT))
QUIT
+2 if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
if '$DATA(@(RT_+($GET(DA(1)))_",66,"_+($GET(DA))_",0)"))
QUIT
+3 SET ICDCOD=$PIECE($GET(@(RT_+($GET(DA(1)))_",0)")),"^",1)
SET ICDNOD=$GET(@(RT_+($GET(DA(1)))_",66,"_+($GET(DA))_",0)"))
+4 SET ICDSTA=$PIECE(ICDNOD,"^",2)
SET ICDEFF=$PIECE(ICDNOD,"^",1)
+5 QUIT
SHIS ; Set ^ROOT("ACT",<code>,<status>,<date>,<ien>,<history>)
+1 ; Set ^ROOT("ACTS",<sys>,<code>,<status>,<date>,<ien>,<history>)
+2 if '$LENGTH($GET(RT))
QUIT
NEW EXC
if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
+3 if '$DATA(@(RT_+($GET(DA(1)))_",66,"_+($GET(DA))_",0)"))
QUIT
+4 if '$LENGTH($GET(ICDCOD))
QUIT
if '$LENGTH($GET(ICDSTA))
QUIT
if '$LENGTH($GET(ICDEFF))
QUIT
+5 SET @(RT_"""ACT"","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")=""
+6 if +($GET(ICDSYS))>0
SET @(RT_"""ACTS"","_+ICDSYS_","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")=""
+7 IF +($GET(ICDSYS))'>0
Begin DoDot:1
+8 NEW SYS
SET SYS=+($PIECE($GET(@(RT_+DA(1)_",1)")),"^",1))
+9 if +SYS>0
SET @(RT_"""ACTS"","_+SYS_","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")=""
End DoDot:1
+10 QUIT
KHIS ; Kill ^ROOT("ACT",<code>,<status>,<date>,<ien>,<history>)
+1 ; Kill ^ROOT("ACTS",<sys>,<code>,<status>,<date>,<ien>,<history>)
+2 if '$LENGTH($GET(RT))
QUIT
if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
if '$DATA(@(RT_+($GET(DA(1)))_",66,"_+($GET(DA))_",0)"))
QUIT
+3 if '$LENGTH($GET(ICDCOD))
QUIT
if '$LENGTH($GET(ICDSTA))
QUIT
if '$LENGTH($GET(ICDEFF))
QUIT
+4 KILL @(RT_"""ACT"","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")
+5 if +($GET(ICDSYS))>0
KILL @(RT_"""ACTS"","_+ICDSYS_","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")
+6 IF +($GET(ICDSYS))'>0
Begin DoDot:1
+7 NEW SYS
SET SYS=+($PIECE($GET(@(RT_+DA(1)_",1)")),"^",1))
+8 if +SYS>0
KILL @(RT_"""ACTS"","_+SYS_","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")
End DoDot:1
+9 QUIT
EXC(X,Y) ; Exclude from lookup
+1 NEW COD,EFF,LDS,IEN,RT
SET IEN=+($GET(X))
SET RT=$GET(Y)
if +IEN'>0
QUIT 0
if '$LENGTH(RT)
QUIT 0
SET COD=$PIECE($GET(@(RT_+IEN_",0)")),"^",1)
+2 SET EFF=$ORDER(@(RT_+IEN_",66,0)"))
SET LDS=$ORDER(@(RT_+IEN_",68,0)"))
if $LENGTH(COD)&(+EFF>0)&(+LDS>0)
QUIT 1
+3 QUIT 0
RT(X) ; Root from File #
+1 QUIT $SELECT(+($GET(X))=80:$$ROOT^ICDEX(80),+($GET(X))=80.1:$$ROOT^ICDEX(80.1),1:"")
