ICDIDX ;DLS/DEK - MUMPS Cross Reference Routine ;04/21/2014
;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 1
;
; Global Variables
; None
;
; External References
; IXALL^DIK ICR 10013
; $$UP^XLFSTR ICR 10104
;
; "D" on Description
SD(ICD) ; Set ROOT("D",<word>,<file ien>,<dt>,<des ien>)
Q:'$L($G(X)) Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 N WRDS,I,WD,CDT,EXC,RT S RT=$$RT(+($G(ICD))) Q:'$L(RT) S EXC=$$EXC(DA(1),RT) Q:+EXC'>0
S CDT=$G(@(RT_+($G(DA(1)))_",68,"_+($G(DA))_",0)")),CDT=$P(CDT,"^",1) Q:CDT'?7N D PAR^ICDTOKN($G(X),.WRDS,0) S I=0
F S I=$O(WRDS(I)) Q:+I'>0 S WD=$G(WRDS(I)) S:$L(WD) @(RT_"""D"","""_WD_""","_+DA(1)_","_CDT_","_+DA_")")=""
S IE1=DA(1),IE2=DA,IE3=0 F S IE3=$O(@(RT_+IE1_",68,"_+IE2_",2,"_IE3_")")) Q:+IE3'>0 D
. S KEY=$$TM($G(@(RT_+IE1_",68,"_+IE2_",2,"_+IE3_",0)"))) Q:'$L(KEY)
. S @(RT_"""D"","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")=""
Q
KD(ICD) ; Kill ROOT("D",<word>,<file ien>,<dt>,<des ien>)
Q:'$L($G(X)) Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 N WRDS,I,WD,CDT,EXC,RT S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S CDT=$G(@(RT_+($G(DA(1)))_",68,"_+($G(DA))_",0)")),CDT=$P(CDT,"^",1) Q:CDT'?7N D PAR^ICDTOKN($G(X),.WRDS,0) S I=0
F S I=$O(WRDS(I)) Q:+I'>0 S WD=$G(WRDS(I)) K:$L(WD) @(RT_"""D"","""_WD_""","_+DA(1)_","_CDT_","_+DA_")")
S IE1=DA(1),IE2=DA,IE3=0 F S IE3=$O(@(RT_+IE1_",68,"_+IE2_",2,"_IE3_")")) Q:+IE3'>0 D
. S KEY=$$TM($G(@(RT_+IE1_",68,"_+IE2_",2,"_+IE3_",0)"))) Q:'$L(KEY)
. K @(RT_"""D"","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")
Q
; "AD" on Description
SAD(ICD) ; Set ROOT("AD",<cs>,<word>,<file ien>,<dt>,<des ien>)
Q:'$L($G(X)) Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 N KEY,WRDS,I,WD,CDT,SYS,EXC,RT
S RT=$$RT(+($G(ICD))) Q:'$L(RT) S EXC=$$EXC(DA(1),RT) Q:+EXC'>0
S CDT=$G(@(RT_+($G(DA(1)))_",68,"_+($G(DA))_",0)")),CDT=$P(CDT,"^",1) Q:CDT'?7N
S SYS=+($P($G(@(RT_+DA(1)_",1)")),"^",1)) Q:+SYS'>0 D PAR^ICDTOKN($G(X),.WRDS,0) S I=0
F S I=$O(WRDS(I)) Q:+I'>0 D
. S WD=$G(WRDS(I)) S:$L(WD) @(RT_"""AD"","_+SYS_","""_WD_""","_+DA(1)_","_CDT_","_+DA_")")=""
S IE1=DA(1),IE2=DA,IE3=0
F S IE3=$O(@(RT_+IE1_",68,"_+IE2_",2,"_IE3_")")) Q:+IE3'>0 D
. S KEY=$$TM($G(@(RT_+IE1_",68,"_+IE2_",2,"_+IE3_",0)"))) Q:'$L(KEY)
. S @(RT_"""AD"","_+SYS_","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")=""
. S @(RT_"""D"","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")=""
Q
KAD(ICD) ; Kill ROOT("AD",<cs>,<word>,<file ien>,<dt>,<des ien>)
Q:'$L($G(X)) Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 N KEY,WRDS,I,WD,CDT,SYS,EXC,RT,IE1,IE2,IE3 S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S CDT=$G(@(RT_+($G(DA(1)))_",68,"_+($G(DA))_",0)")),CDT=$P(CDT,"^",1) Q:CDT'?7N
S SYS=+($P($G(@(RT_+DA(1)_",1)")),"^",1)) Q:+SYS'>0 D PAR^ICDTOKN($G(X),.WRDS,0) S I=0
F S I=$O(WRDS(I)) Q:+I'>0 S WD=$G(WRDS(I)) K:$L(WD) @(RT_"""AD"","_+SYS_","""_WD_""","_+DA(1)_","_CDT_","_+DA_")")
S IE1=DA(1),IE2=DA,IE3=0
F S IE3=$O(@(RT_+IE1_",68,"_+IE2_",2,"_IE3_")")) Q:+IE3'>0 D
. S KEY=$$TM($G(@(RT_+IE1_",68,"_+IE2_",2,"_+IE3_",0)"))) Q:'$L(KEY)
. K @(RT_"""AD"","_+SYS_","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")
. K @(RT_"""D"","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")
Q
; "AD" on Coding System
SAD2(ICD) ; Set ROOT("AD",<cs>,<word>,<file ien>,<dt>,<des ien>)
Q:'$L($G(X)) Q:+($G(DA))'>0 N WRDS,I,WD,TXT,KEY,CDT,SYS,IE1,IE2,IE3,EXC,RT S RT=$$RT(+($G(ICD))) Q:'$L(RT) S EXC=$$EXC(DA,RT) Q:+EXC'>0
S SYS=+($G(X)) Q:+SYS'>0 S IE1=+($G(DA)),IE2=0 F S IE2=$O(@(RT_+IE1_",68,"_IE2_")")) Q:+IE2'>0 D
. N I S CDT=$P($G(@(RT_+IE1_",68,"_IE2_",0)")),"^",1) Q:CDT'?7N
. S TXT=$G(@(RT_+IE1_",68,"_IE2_",1)")) I $L(TXT) D
. . D PAR^ICDTOKN(TXT,.WRDS,0) S I=0 F S I=$O(WRDS(I)) Q:+I'>0 S WD=$G(WRDS(I)) D
. . . S:$L(WD) @(RT_"""AD"","_+SYS_","""_WD_""","_+IE1_","_CDT_","_+IE2_")")=""
. S IE3=0 F S IE3=$O(@(RT_+IE1_",68,"_+IE2_",2,"_IE3_")")) Q:+IE3'>0 D
. . S KEY=$$TM($G(@(RT_+IE1_",68,"_+IE2_",2,"_+IE3_",0)"))) Q:'$L(KEY)
. . S @(RT_"""AD"","_+SYS_","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")=""
. . S @(RT_"""D"","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")=""
Q
KAD2(ICD) ; Kill ROOT("AD",<cs>,<word>,<file ien>,<dt>,<des ien>)
Q:'$L($G(X)) Q:+($G(DA))'>0 N WRDS,I,WD,TXT,CDT,SYS,IE1,IE2,EXC,RT S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S SYS=+($G(X)) Q:+SYS'>0 S IE1=+($G(DA)),IE2=0 F S IE2=$O(@(RT_+IE1_",68,"_IE2_")")) Q:+IE2'>0 D
. N I S CDT=$P($G(@(RT_+IE1_",68,"_IE2_",0)")),"^",1) Q:CDT'?7N
. S TXT=$G(@(RT_+IE1_",68,"_IE2_",1)")) I $L(TXT) D
. . D PAR^ICDTOKN(TXT,.WRDS,0) S I=0 F S I=$O(WRDS(I)) Q:+I'>0 S WD=$G(WRDS(I)) D
. . . K:$L(WD) @(RT_"""AD"","_+SYS_","""_WD_""","_+IE1_","_CDT_","_+IE2_")")
. S IE3=0 F S IE3=$O(@(RT_+IE1_",68,"_+IE2_",2,"_IE3_")")) Q:+IE3'>0 D
. . S KEY=$$TM($G(@(RT_+IE1_",68,"_+IE2_",2,"_+IE3_",0)"))) Q:'$L(KEY)
. . K @(RT_"""AD"","_+SYS_","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")
. . K @(RT_"""D"","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")
Q
; "AD" on Keywords
SAD3(ICD) ; Set ROOT("AD",<cs>,<word>,<file ien>,<dt>,<des ien>,<wd ien>)
N KEY S KEY=$$UP^XLFSTR($$TM($G(X))) Q:'$L(KEY) Q:+($G(DA(2)))'>0 Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0
N CDT,SYS,EXC,RT S RT=$$RT(+($G(ICD))) Q:'$L(RT) S EXC=$$EXC(DA(2),RT) Q:+EXC'>0
S CDT=$G(@(RT_+($G(DA(2)))_",68,"_+($G(DA(1)))_",0)")),CDT=$P(CDT,"^",1) Q:CDT'?7N
S SYS=+($P($G(@(RT_+DA(2)_",1)")),"^",1)) Q:+SYS'>0
S @(RT_"""AD"","_+SYS_","""_KEY_""","_+DA(2)_","_CDT_","_+DA(1)_","_+DA_")")=""
S @(RT_"""D"","""_KEY_""","_+DA(2)_","_CDT_","_+DA(1)_","_+DA_")")=""
Q
KAD3(ICD) ; Kill ROOT("AD",<cs>,<word>,<file ien>,<dt>,<des ien>,<wd ien>)
N KEY S KEY=$$UP^XLFSTR($$TM($G(X))) Q:'$L(KEY) Q:+($G(DA(2)))'>0 Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0
N CDT,SYS,EXC,RT S RT=$$RT(+($G(ICD))) Q:'$L(RT) S EXC=$$EXC(DA(2),RT) Q:+EXC'>0
S CDT=$G(@(RT_+($G(DA(2)))_",68,"_+($G(DA(1)))_",0)")),CDT=$P(CDT,"^",1) Q:CDT'?7N
S SYS=+($P($G(@(RT_+DA(2)_",1)")),"^",1)) Q:+SYS'>0
K @(RT_"""AD"","_+SYS_","""_KEY_""","_+DA(2)_","_CDT_","_+DA(1)_","_+DA_")")
K @(RT_"""D"","""_KEY_""","_+DA(2)_","_CDT_","_+DA(1)_","_+DA_")")
Q
; "AST" on short text effective date
SAST(ICD) ; Set ROOT("AST",<code>,<dt>,<file ien>,<st ien>)
Q:'$L($G(X)) Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 N EXC,COD,SYS,RT,CDT S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S EXC=+($$EXC(DA(1),RT)) Q:+EXC'>0 S CDT=+($G(X)) Q:CDT'?7N S COD=$P($G(@(RT_DA(1)_",0)")),"^",1) Q:'$L(COD)
S SYS=$P($G(@(RT_DA(1)_",1)")),"^",1) S @(RT_"""AST"","""_(COD_" ")_""","_CDT_","_DA(1)_","_DA_")")=""
Q
KAST(ICD) ; Kill ROOT("AST",<code>,<dt>,<file ien>,<st ien>)
Q:'$L($G(X)) Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 N EXC,COD,SYS,RT,CDT S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S CDT=+($G(X)) Q:CDT'?7N S COD=$P($G(@(RT_DA(1)_",0)")),"^",1) Q:'$L(COD)
S SYS=$P($G(@(RT_DA(1)_",1)")),"^",1) K @(RT_"""AST"","""_(COD_" ")_""","_CDT_","_DA(1)_","_DA_")")
Q
; "ASTS" on short text effective date
SASTS1(ICD) ; Set ROOT("ASTS",<cs>,<code>,<dt>,<file ien>,<st ien>)
Q:'$L($G(X)) Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 N EXC,COD,SYS,RT,CDT S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S EXC=+($$EXC(DA(1),RT)) Q:+EXC'>0 S CDT=+($G(X)) Q:CDT'?7N S COD=$P($G(@(RT_DA(1)_",0)")),"^",1) Q:'$L(COD)
S SYS=$P($G(@(RT_DA(1)_",1)")),"^",1) Q:+SYS'>0
S @(RT_"""ASTS"","_+SYS_","""_(COD_" ")_""","_CDT_","_DA(1)_","_DA_")")=""
Q
KASTS1(ICD) ; Kill ROOT("ASTS",<cs>,<code>,<dt>,<file ien>,<st ien>)
Q:'$L($G(X)) Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 N EXC,COD,SYS,RT,CDT S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S CDT=+($G(X)) Q:CDT'?7N S COD=$P($G(@(RT_DA(1)_",0)")),"^",1) Q:'$L(COD)
S SYS=$P($G(@(RT_DA(1)_",1)")),"^",1) Q:+SYS'>0
K @(RT_"""ASTS"","_+SYS_","""_(COD_" ")_""","_CDT_","_DA(1)_","_DA_")")
Q
; "ASTS" on short text
SASTS2(ICD) ; Set ROOT("ASTS",<cs>,<code>,<dt>,<file ien>,<st ien>)
Q:'$L($G(X)) Q:+($G(DA))'>0 N WRDS,I,WD,TXT,COD,CDT,SYS,IE1,IE2,EXC,RT S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S EXC=$$EXC(DA,RT) Q:+EXC'>0 S SYS=+($G(X)) Q:+SYS'>0 S COD=$P($G(@(RT_+($G(DA))_",0)")),"^",1) Q:'$L(COD)
S IE1=+($G(DA)),IE2=0 F S IE2=$O(@(RT_+IE1_",67,"_IE2_")")) Q:+IE2'>0 D
. N I S CDT=$P($G(@(RT_+IE1_",67,"_IE2_",0)")),"^",1) Q:CDT'?7N
. S @(RT_"""ASTS"","_+SYS_","""_(COD_" ")_""","_CDT_","_IE1_","_IE2_")")=""
Q
KASTS2(ICD) ; Set ROOT("ASTS",<cs>,<code>,<dt>,<file ien>,<dx ien>)
Q:'$L($G(X)) Q:+($G(DA))'>0 N WRDS,I,WD,TXT,COD,CDT,SYS,IE1,IE2,EXC,RT S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S SYS=+($G(X)) Q:+SYS'>0 S COD=$P($G(@(RT_+($G(DA))_",0)")),"^",1) Q:'$L(COD)
S IE1=+($G(DA)),IE2=0 F S IE2=$O(@(RT_+IE1_",67,"_IE2_")")) Q:+IE2'>0 D
. N I S CDT=$P($G(@(RT_+IE1_",67,"_IE2_",0)")),"^",1) Q:CDT'?7N
. K @(RT_"""ASTS"","_+SYS_","""_(COD_" ")_""","_CDT_","_IE1_","_IE2_")")
Q
;
SADS(ICD) ; Set ROOT("ADS",<code>,<dt>,<file ien>,<dx ien>)
Q:'$L($G(X)) Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 N EXC,COD,SYS,RT,CDT S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S EXC=+($$EXC(DA(1),RT)) Q:+EXC'>0 S CDT=+($G(X)) Q:CDT'?7N S COD=$P($G(@(RT_DA(1)_",0)")),"^",1) Q:'$L(COD)
S @(RT_"""ADS"","""_(COD_" ")_""","_CDT_","_DA(1)_","_DA_")")=""
Q
KADS(ICD) ; Kill ROOT("ADS",<code>,<dt>,<file ien>,<dx ien>)
Q:'$L($G(X)) Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 N EXC,COD,SYS,RT,CDT S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S CDT=+($G(X)) Q:CDT'?7N S COD=$P($G(@(RT_DA(1)_",0)")),"^",1) Q:'$L(COD)
K @(RT_"""ADS"","""_(COD_" ")_""","_CDT_","_DA(1)_","_DA_")")
Q
SADSS1(ICD) ; Set ROOT("ADSS",SYS,<code>,<dt>,<file ien>,<dx ien>)
Q:'$L($G(X)) Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 N EXC,COD,SYS,RT,CDT S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S EXC=+($$EXC(DA(1),RT)) Q:+EXC'>0 S CDT=+($G(X)) Q:CDT'?7N S COD=$P($G(@(RT_DA(1)_",0)")),"^",1) Q:'$L(COD)
S SYS=$P($G(@(RT_DA(1)_",1)")),"^",1) Q:+SYS'>0
S @(RT_"""ADSS"","_+SYS_","""_(COD_" ")_""","_CDT_","_DA(1)_","_DA_")")=""
Q
KADSS1(ICD) ; Kill ROOT("ADSS",SYS,<code>,<dt>,<file ien>,<dx ien>)
Q:'$L($G(X)) Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 N EXC,COD,SYS,RT,CDT S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S CDT=+($G(X)) Q:CDT'?7N S COD=$P($G(@(RT_DA(1)_",0)")),"^",1) Q:'$L(COD)
S SYS=$P($G(@(RT_DA(1)_",1)")),"^",1) Q:+SYS'>0
K @(RT_"""ADSS"","_+SYS_","""_(COD_" ")_""","_CDT_","_DA(1)_","_DA_")")
Q
SADSS2(ICD) ; Set ROOT("ADSS",SYS,<code>,<dt>,<file ien>,<dx ien>)
Q:'$L($G(X)) Q:+($G(DA))'>0 N WRDS,I,WD,TXT,COD,CDT,SYS,IE1,IE2,EXC,RT S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S EXC=$$EXC(DA,RT) Q:+EXC'>0 S SYS=+($G(X)) Q:+SYS'>0 S COD=$P($G(@(RT_+($G(DA))_",0)")),"^",1) Q:'$L(COD)
S IE1=+($G(DA)),IE2=0 F S IE2=$O(@(RT_+IE1_",68,"_IE2_")")) Q:+IE2'>0 D
. N I S CDT=$P($G(@(RT_+IE1_",68,"_IE2_",0)")),"^",1) Q:CDT'?7N
. S @(RT_"""ADSS"","_+SYS_","""_(COD_" ")_""","_CDT_","_IE1_","_IE2_")")=""
Q
KADSS2(ICD) ; Set ROOT("ADSS",SYS,<code>,<dt>,<file ien>,<dx ien>)
Q:'$L($G(X)) Q:+($G(DA))'>0 N WRDS,I,WD,TXT,COD,CDT,SYS,IE1,IE2,EXC,RT S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S SYS=+($G(X)) Q:+SYS'>0 S COD=$P($G(@(RT_+($G(DA))_",0)")),"^",1) Q:'$L(COD)
S IE1=+($G(DA)),IE2=0 F S IE2=$O(@(RT_+IE1_",68,"_IE2_")")) Q:+IE2'>0 D
. N I S CDT=$P($G(@(RT_+IE1_",68,"_IE2_",0)")),"^",1) Q:CDT'?7N
. K @(RT_"""ADSS"","_+SYS_","""_(COD_" ")_""","_CDT_","_IE1_","_IE2_")")
Q
SAEXC(ICD) ; Set ROOT("AEXC",<code>,<ien>)
Q:+($G(DA))'>0 N COD,EXC,RT S RT=$$RT(+($G(ICD))) Q:'$L(RT) S COD=$P($G(@(RT_+DA_",0)")),"^",1) Q:'$L(COD)
S EXC=$$EXC(DA,RT) S:+EXC'>0 @(RT_"""AEXC"","""_(COD_" ")_""","_DA_")")=""
Q
KAEXC(ICD) ; Kill ROOT("AEXC",<code>,<ien>)
Q:+($G(DA))'>0 N COD,EXC,RT S RT=$$RT(+($G(ICD))) Q:'$L(RT) S COD=$P($G(@(RT_+DA_",0)")),"^",1) Q:'$L(COD)
K @(RT_"""AEXC"","""_(COD_" ")_""","_DA_")")
Q
;
; Miscellaneous
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
RM(ICD) ; Remove Main
N IX,RT S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S IX=" " F S IX=$O(@(RT_""""_IX_""")")) Q:'$L(IX) D
. K @(RT_""""_IX_""")")
Q
RE(ICD) ; Re-Index
N ZTQUEUED,DIK,IX,RT,DA S RT=$$RT(+($G(ICD))) Q:'$L(RT)
S DIK=RT,ZTQUEUED="" D IXALL^DIK
Q
RT(X) ; Root from File #
Q $S(+($G(X))=80:$$ROOT^ICDEX(80),+($G(X))=80.1:$$ROOT^ICDEX(80.1),1:"")
TM(X,Y) ; Trim Y
S X=$G(X),Y=$G(Y) S:'$L(Y) Y=" "
F Q:$E(X,1)'=Y S X=$E(X,2,$L(X))
F Q:$E(X,$L(X))'=Y S X=$E(X,1,($L(X)-1))
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICDIDX 12485 printed Sep 23, 2025@19:26:56 Page 2
ICDIDX ;DLS/DEK - MUMPS Cross Reference Routine ;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 ; IXALL^DIK ICR 10013
+8 ; $$UP^XLFSTR ICR 10104
+9 ;
+10 ; "D" on Description
SD(ICD) ; Set ROOT("D",<word>,<file ien>,<dt>,<des ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
NEW WRDS,I,WD,CDT,EXC,RT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
SET EXC=$$EXC(DA(1),RT)
if +EXC'>0
QUIT
+2 SET CDT=$GET(@(RT_+($GET(DA(1)))_",68,"_+($GET(DA))_",0)"))
SET CDT=$PIECE(CDT,"^",1)
if CDT'?7N
QUIT
DO PAR^ICDTOKN($GET(X),.WRDS,0)
SET I=0
+3 FOR
SET I=$ORDER(WRDS(I))
if +I'>0
QUIT
SET WD=$GET(WRDS(I))
if $LENGTH(WD)
SET @(RT_"""D"","""_WD_""","_+DA(1)_","_CDT_","_+DA_")")=""
+4 SET IE1=DA(1)
SET IE2=DA
SET IE3=0
FOR
SET IE3=$ORDER(@(RT_+IE1_",68,"_+IE2_",2,"_IE3_")"))
if +IE3'>0
QUIT
Begin DoDot:1
+5 SET KEY=$$TM($GET(@(RT_+IE1_",68,"_+IE2_",2,"_+IE3_",0)")))
if '$LENGTH(KEY)
QUIT
+6 SET @(RT_"""D"","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")=""
End DoDot:1
+7 QUIT
KD(ICD) ; Kill ROOT("D",<word>,<file ien>,<dt>,<des ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
NEW WRDS,I,WD,CDT,EXC,RT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET CDT=$GET(@(RT_+($GET(DA(1)))_",68,"_+($GET(DA))_",0)"))
SET CDT=$PIECE(CDT,"^",1)
if CDT'?7N
QUIT
DO PAR^ICDTOKN($GET(X),.WRDS,0)
SET I=0
+3 FOR
SET I=$ORDER(WRDS(I))
if +I'>0
QUIT
SET WD=$GET(WRDS(I))
if $LENGTH(WD)
KILL @(RT_"""D"","""_WD_""","_+DA(1)_","_CDT_","_+DA_")")
+4 SET IE1=DA(1)
SET IE2=DA
SET IE3=0
FOR
SET IE3=$ORDER(@(RT_+IE1_",68,"_+IE2_",2,"_IE3_")"))
if +IE3'>0
QUIT
Begin DoDot:1
+5 SET KEY=$$TM($GET(@(RT_+IE1_",68,"_+IE2_",2,"_+IE3_",0)")))
if '$LENGTH(KEY)
QUIT
+6 KILL @(RT_"""D"","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")
End DoDot:1
+7 QUIT
+8 ; "AD" on Description
SAD(ICD) ; Set ROOT("AD",<cs>,<word>,<file ien>,<dt>,<des ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
NEW KEY,WRDS,I,WD,CDT,SYS,EXC,RT
+2 SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
SET EXC=$$EXC(DA(1),RT)
if +EXC'>0
QUIT
+3 SET CDT=$GET(@(RT_+($GET(DA(1)))_",68,"_+($GET(DA))_",0)"))
SET CDT=$PIECE(CDT,"^",1)
if CDT'?7N
QUIT
+4 SET SYS=+($PIECE($GET(@(RT_+DA(1)_",1)")),"^",1))
if +SYS'>0
QUIT
DO PAR^ICDTOKN($GET(X),.WRDS,0)
SET I=0
+5 FOR
SET I=$ORDER(WRDS(I))
if +I'>0
QUIT
Begin DoDot:1
+6 SET WD=$GET(WRDS(I))
if $LENGTH(WD)
SET @(RT_"""AD"","_+SYS_","""_WD_""","_+DA(1)_","_CDT_","_+DA_")")=""
End DoDot:1
+7 SET IE1=DA(1)
SET IE2=DA
SET IE3=0
+8 FOR
SET IE3=$ORDER(@(RT_+IE1_",68,"_+IE2_",2,"_IE3_")"))
if +IE3'>0
QUIT
Begin DoDot:1
+9 SET KEY=$$TM($GET(@(RT_+IE1_",68,"_+IE2_",2,"_+IE3_",0)")))
if '$LENGTH(KEY)
QUIT
+10 SET @(RT_"""AD"","_+SYS_","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")=""
+11 SET @(RT_"""D"","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")=""
End DoDot:1
+12 QUIT
KAD(ICD) ; Kill ROOT("AD",<cs>,<word>,<file ien>,<dt>,<des ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
NEW KEY,WRDS,I,WD,CDT,SYS,EXC,RT,IE1,IE2,IE3
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET CDT=$GET(@(RT_+($GET(DA(1)))_",68,"_+($GET(DA))_",0)"))
SET CDT=$PIECE(CDT,"^",1)
if CDT'?7N
QUIT
+3 SET SYS=+($PIECE($GET(@(RT_+DA(1)_",1)")),"^",1))
if +SYS'>0
QUIT
DO PAR^ICDTOKN($GET(X),.WRDS,0)
SET I=0
+4 FOR
SET I=$ORDER(WRDS(I))
if +I'>0
QUIT
SET WD=$GET(WRDS(I))
if $LENGTH(WD)
KILL @(RT_"""AD"","_+SYS_","""_WD_""","_+DA(1)_","_CDT_","_+DA_")")
+5 SET IE1=DA(1)
SET IE2=DA
SET IE3=0
+6 FOR
SET IE3=$ORDER(@(RT_+IE1_",68,"_+IE2_",2,"_IE3_")"))
if +IE3'>0
QUIT
Begin DoDot:1
+7 SET KEY=$$TM($GET(@(RT_+IE1_",68,"_+IE2_",2,"_+IE3_",0)")))
if '$LENGTH(KEY)
QUIT
+8 KILL @(RT_"""AD"","_+SYS_","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")
+9 KILL @(RT_"""D"","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")
End DoDot:1
+10 QUIT
+11 ; "AD" on Coding System
SAD2(ICD) ; Set ROOT("AD",<cs>,<word>,<file ien>,<dt>,<des ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA))'>0
QUIT
NEW WRDS,I,WD,TXT,KEY,CDT,SYS,IE1,IE2,IE3,EXC,RT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
SET EXC=$$EXC(DA,RT)
if +EXC'>0
QUIT
+2 SET SYS=+($GET(X))
if +SYS'>0
QUIT
SET IE1=+($GET(DA))
SET IE2=0
FOR
SET IE2=$ORDER(@(RT_+IE1_",68,"_IE2_")"))
if +IE2'>0
QUIT
Begin DoDot:1
+3 NEW I
SET CDT=$PIECE($GET(@(RT_+IE1_",68,"_IE2_",0)")),"^",1)
if CDT'?7N
QUIT
+4 SET TXT=$GET(@(RT_+IE1_",68,"_IE2_",1)"))
IF $LENGTH(TXT)
Begin DoDot:2
+5 DO PAR^ICDTOKN(TXT,.WRDS,0)
SET I=0
FOR
SET I=$ORDER(WRDS(I))
if +I'>0
QUIT
SET WD=$GET(WRDS(I))
Begin DoDot:3
+6 if $LENGTH(WD)
SET @(RT_"""AD"","_+SYS_","""_WD_""","_+IE1_","_CDT_","_+IE2_")")=""
End DoDot:3
End DoDot:2
+7 SET IE3=0
FOR
SET IE3=$ORDER(@(RT_+IE1_",68,"_+IE2_",2,"_IE3_")"))
if +IE3'>0
QUIT
Begin DoDot:2
+8 SET KEY=$$TM($GET(@(RT_+IE1_",68,"_+IE2_",2,"_+IE3_",0)")))
if '$LENGTH(KEY)
QUIT
+9 SET @(RT_"""AD"","_+SYS_","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")=""
+10 SET @(RT_"""D"","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")=""
End DoDot:2
End DoDot:1
+11 QUIT
KAD2(ICD) ; Kill ROOT("AD",<cs>,<word>,<file ien>,<dt>,<des ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA))'>0
QUIT
NEW WRDS,I,WD,TXT,CDT,SYS,IE1,IE2,EXC,RT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET SYS=+($GET(X))
if +SYS'>0
QUIT
SET IE1=+($GET(DA))
SET IE2=0
FOR
SET IE2=$ORDER(@(RT_+IE1_",68,"_IE2_")"))
if +IE2'>0
QUIT
Begin DoDot:1
+3 NEW I
SET CDT=$PIECE($GET(@(RT_+IE1_",68,"_IE2_",0)")),"^",1)
if CDT'?7N
QUIT
+4 SET TXT=$GET(@(RT_+IE1_",68,"_IE2_",1)"))
IF $LENGTH(TXT)
Begin DoDot:2
+5 DO PAR^ICDTOKN(TXT,.WRDS,0)
SET I=0
FOR
SET I=$ORDER(WRDS(I))
if +I'>0
QUIT
SET WD=$GET(WRDS(I))
Begin DoDot:3
+6 if $LENGTH(WD)
KILL @(RT_"""AD"","_+SYS_","""_WD_""","_+IE1_","_CDT_","_+IE2_")")
End DoDot:3
End DoDot:2
+7 SET IE3=0
FOR
SET IE3=$ORDER(@(RT_+IE1_",68,"_+IE2_",2,"_IE3_")"))
if +IE3'>0
QUIT
Begin DoDot:2
+8 SET KEY=$$TM($GET(@(RT_+IE1_",68,"_+IE2_",2,"_+IE3_",0)")))
if '$LENGTH(KEY)
QUIT
+9 KILL @(RT_"""AD"","_+SYS_","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")
+10 KILL @(RT_"""D"","""_KEY_""","_+IE1_","_CDT_","_+IE2_","_+IE3_")")
End DoDot:2
End DoDot:1
+11 QUIT
+12 ; "AD" on Keywords
SAD3(ICD) ; Set ROOT("AD",<cs>,<word>,<file ien>,<dt>,<des ien>,<wd ien>)
+1 NEW KEY
SET KEY=$$UP^XLFSTR($$TM($GET(X)))
if '$LENGTH(KEY)
QUIT
if +($GET(DA(2)))'>0
QUIT
if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
+2 NEW CDT,SYS,EXC,RT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
SET EXC=$$EXC(DA(2),RT)
if +EXC'>0
QUIT
+3 SET CDT=$GET(@(RT_+($GET(DA(2)))_",68,"_+($GET(DA(1)))_",0)"))
SET CDT=$PIECE(CDT,"^",1)
if CDT'?7N
QUIT
+4 SET SYS=+($PIECE($GET(@(RT_+DA(2)_",1)")),"^",1))
if +SYS'>0
QUIT
+5 SET @(RT_"""AD"","_+SYS_","""_KEY_""","_+DA(2)_","_CDT_","_+DA(1)_","_+DA_")")=""
+6 SET @(RT_"""D"","""_KEY_""","_+DA(2)_","_CDT_","_+DA(1)_","_+DA_")")=""
+7 QUIT
KAD3(ICD) ; Kill ROOT("AD",<cs>,<word>,<file ien>,<dt>,<des ien>,<wd ien>)
+1 NEW KEY
SET KEY=$$UP^XLFSTR($$TM($GET(X)))
if '$LENGTH(KEY)
QUIT
if +($GET(DA(2)))'>0
QUIT
if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
+2 NEW CDT,SYS,EXC,RT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
SET EXC=$$EXC(DA(2),RT)
if +EXC'>0
QUIT
+3 SET CDT=$GET(@(RT_+($GET(DA(2)))_",68,"_+($GET(DA(1)))_",0)"))
SET CDT=$PIECE(CDT,"^",1)
if CDT'?7N
QUIT
+4 SET SYS=+($PIECE($GET(@(RT_+DA(2)_",1)")),"^",1))
if +SYS'>0
QUIT
+5 KILL @(RT_"""AD"","_+SYS_","""_KEY_""","_+DA(2)_","_CDT_","_+DA(1)_","_+DA_")")
+6 KILL @(RT_"""D"","""_KEY_""","_+DA(2)_","_CDT_","_+DA(1)_","_+DA_")")
+7 QUIT
+8 ; "AST" on short text effective date
SAST(ICD) ; Set ROOT("AST",<code>,<dt>,<file ien>,<st ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
NEW EXC,COD,SYS,RT,CDT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET EXC=+($$EXC(DA(1),RT))
if +EXC'>0
QUIT
SET CDT=+($GET(X))
if CDT'?7N
QUIT
SET COD=$PIECE($GET(@(RT_DA(1)_",0)")),"^",1)
if '$LENGTH(COD)
QUIT
+3 SET SYS=$PIECE($GET(@(RT_DA(1)_",1)")),"^",1)
SET @(RT_"""AST"","""_(COD_" ")_""","_CDT_","_DA(1)_","_DA_")")=""
+4 QUIT
KAST(ICD) ; Kill ROOT("AST",<code>,<dt>,<file ien>,<st ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
NEW EXC,COD,SYS,RT,CDT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET CDT=+($GET(X))
if CDT'?7N
QUIT
SET COD=$PIECE($GET(@(RT_DA(1)_",0)")),"^",1)
if '$LENGTH(COD)
QUIT
+3 SET SYS=$PIECE($GET(@(RT_DA(1)_",1)")),"^",1)
KILL @(RT_"""AST"","""_(COD_" ")_""","_CDT_","_DA(1)_","_DA_")")
+4 QUIT
+5 ; "ASTS" on short text effective date
SASTS1(ICD) ; Set ROOT("ASTS",<cs>,<code>,<dt>,<file ien>,<st ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
NEW EXC,COD,SYS,RT,CDT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET EXC=+($$EXC(DA(1),RT))
if +EXC'>0
QUIT
SET CDT=+($GET(X))
if CDT'?7N
QUIT
SET COD=$PIECE($GET(@(RT_DA(1)_",0)")),"^",1)
if '$LENGTH(COD)
QUIT
+3 SET SYS=$PIECE($GET(@(RT_DA(1)_",1)")),"^",1)
if +SYS'>0
QUIT
+4 SET @(RT_"""ASTS"","_+SYS_","""_(COD_" ")_""","_CDT_","_DA(1)_","_DA_")")=""
+5 QUIT
KASTS1(ICD) ; Kill ROOT("ASTS",<cs>,<code>,<dt>,<file ien>,<st ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
NEW EXC,COD,SYS,RT,CDT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET CDT=+($GET(X))
if CDT'?7N
QUIT
SET COD=$PIECE($GET(@(RT_DA(1)_",0)")),"^",1)
if '$LENGTH(COD)
QUIT
+3 SET SYS=$PIECE($GET(@(RT_DA(1)_",1)")),"^",1)
if +SYS'>0
QUIT
+4 KILL @(RT_"""ASTS"","_+SYS_","""_(COD_" ")_""","_CDT_","_DA(1)_","_DA_")")
+5 QUIT
+6 ; "ASTS" on short text
SASTS2(ICD) ; Set ROOT("ASTS",<cs>,<code>,<dt>,<file ien>,<st ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA))'>0
QUIT
NEW WRDS,I,WD,TXT,COD,CDT,SYS,IE1,IE2,EXC,RT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET EXC=$$EXC(DA,RT)
if +EXC'>0
QUIT
SET SYS=+($GET(X))
if +SYS'>0
QUIT
SET COD=$PIECE($GET(@(RT_+($GET(DA))_",0)")),"^",1)
if '$LENGTH(COD)
QUIT
+3 SET IE1=+($GET(DA))
SET IE2=0
FOR
SET IE2=$ORDER(@(RT_+IE1_",67,"_IE2_")"))
if +IE2'>0
QUIT
Begin DoDot:1
+4 NEW I
SET CDT=$PIECE($GET(@(RT_+IE1_",67,"_IE2_",0)")),"^",1)
if CDT'?7N
QUIT
+5 SET @(RT_"""ASTS"","_+SYS_","""_(COD_" ")_""","_CDT_","_IE1_","_IE2_")")=""
End DoDot:1
+6 QUIT
KASTS2(ICD) ; Set ROOT("ASTS",<cs>,<code>,<dt>,<file ien>,<dx ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA))'>0
QUIT
NEW WRDS,I,WD,TXT,COD,CDT,SYS,IE1,IE2,EXC,RT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET SYS=+($GET(X))
if +SYS'>0
QUIT
SET COD=$PIECE($GET(@(RT_+($GET(DA))_",0)")),"^",1)
if '$LENGTH(COD)
QUIT
+3 SET IE1=+($GET(DA))
SET IE2=0
FOR
SET IE2=$ORDER(@(RT_+IE1_",67,"_IE2_")"))
if +IE2'>0
QUIT
Begin DoDot:1
+4 NEW I
SET CDT=$PIECE($GET(@(RT_+IE1_",67,"_IE2_",0)")),"^",1)
if CDT'?7N
QUIT
+5 KILL @(RT_"""ASTS"","_+SYS_","""_(COD_" ")_""","_CDT_","_IE1_","_IE2_")")
End DoDot:1
+6 QUIT
+7 ;
SADS(ICD) ; Set ROOT("ADS",<code>,<dt>,<file ien>,<dx ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
NEW EXC,COD,SYS,RT,CDT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET EXC=+($$EXC(DA(1),RT))
if +EXC'>0
QUIT
SET CDT=+($GET(X))
if CDT'?7N
QUIT
SET COD=$PIECE($GET(@(RT_DA(1)_",0)")),"^",1)
if '$LENGTH(COD)
QUIT
+3 SET @(RT_"""ADS"","""_(COD_" ")_""","_CDT_","_DA(1)_","_DA_")")=""
+4 QUIT
KADS(ICD) ; Kill ROOT("ADS",<code>,<dt>,<file ien>,<dx ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
NEW EXC,COD,SYS,RT,CDT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET CDT=+($GET(X))
if CDT'?7N
QUIT
SET COD=$PIECE($GET(@(RT_DA(1)_",0)")),"^",1)
if '$LENGTH(COD)
QUIT
+3 KILL @(RT_"""ADS"","""_(COD_" ")_""","_CDT_","_DA(1)_","_DA_")")
+4 QUIT
SADSS1(ICD) ; Set ROOT("ADSS",SYS,<code>,<dt>,<file ien>,<dx ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
NEW EXC,COD,SYS,RT,CDT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET EXC=+($$EXC(DA(1),RT))
if +EXC'>0
QUIT
SET CDT=+($GET(X))
if CDT'?7N
QUIT
SET COD=$PIECE($GET(@(RT_DA(1)_",0)")),"^",1)
if '$LENGTH(COD)
QUIT
+3 SET SYS=$PIECE($GET(@(RT_DA(1)_",1)")),"^",1)
if +SYS'>0
QUIT
+4 SET @(RT_"""ADSS"","_+SYS_","""_(COD_" ")_""","_CDT_","_DA(1)_","_DA_")")=""
+5 QUIT
KADSS1(ICD) ; Kill ROOT("ADSS",SYS,<code>,<dt>,<file ien>,<dx ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA(1)))'>0
QUIT
if +($GET(DA))'>0
QUIT
NEW EXC,COD,SYS,RT,CDT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET CDT=+($GET(X))
if CDT'?7N
QUIT
SET COD=$PIECE($GET(@(RT_DA(1)_",0)")),"^",1)
if '$LENGTH(COD)
QUIT
+3 SET SYS=$PIECE($GET(@(RT_DA(1)_",1)")),"^",1)
if +SYS'>0
QUIT
+4 KILL @(RT_"""ADSS"","_+SYS_","""_(COD_" ")_""","_CDT_","_DA(1)_","_DA_")")
+5 QUIT
SADSS2(ICD) ; Set ROOT("ADSS",SYS,<code>,<dt>,<file ien>,<dx ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA))'>0
QUIT
NEW WRDS,I,WD,TXT,COD,CDT,SYS,IE1,IE2,EXC,RT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET EXC=$$EXC(DA,RT)
if +EXC'>0
QUIT
SET SYS=+($GET(X))
if +SYS'>0
QUIT
SET COD=$PIECE($GET(@(RT_+($GET(DA))_",0)")),"^",1)
if '$LENGTH(COD)
QUIT
+3 SET IE1=+($GET(DA))
SET IE2=0
FOR
SET IE2=$ORDER(@(RT_+IE1_",68,"_IE2_")"))
if +IE2'>0
QUIT
Begin DoDot:1
+4 NEW I
SET CDT=$PIECE($GET(@(RT_+IE1_",68,"_IE2_",0)")),"^",1)
if CDT'?7N
QUIT
+5 SET @(RT_"""ADSS"","_+SYS_","""_(COD_" ")_""","_CDT_","_IE1_","_IE2_")")=""
End DoDot:1
+6 QUIT
KADSS2(ICD) ; Set ROOT("ADSS",SYS,<code>,<dt>,<file ien>,<dx ien>)
+1 if '$LENGTH($GET(X))
QUIT
if +($GET(DA))'>0
QUIT
NEW WRDS,I,WD,TXT,COD,CDT,SYS,IE1,IE2,EXC,RT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET SYS=+($GET(X))
if +SYS'>0
QUIT
SET COD=$PIECE($GET(@(RT_+($GET(DA))_",0)")),"^",1)
if '$LENGTH(COD)
QUIT
+3 SET IE1=+($GET(DA))
SET IE2=0
FOR
SET IE2=$ORDER(@(RT_+IE1_",68,"_IE2_")"))
if +IE2'>0
QUIT
Begin DoDot:1
+4 NEW I
SET CDT=$PIECE($GET(@(RT_+IE1_",68,"_IE2_",0)")),"^",1)
if CDT'?7N
QUIT
+5 KILL @(RT_"""ADSS"","_+SYS_","""_(COD_" ")_""","_CDT_","_IE1_","_IE2_")")
End DoDot:1
+6 QUIT
SAEXC(ICD) ; Set ROOT("AEXC",<code>,<ien>)
+1 if +($GET(DA))'>0
QUIT
NEW COD,EXC,RT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
SET COD=$PIECE($GET(@(RT_+DA_",0)")),"^",1)
if '$LENGTH(COD)
QUIT
+2 SET EXC=$$EXC(DA,RT)
if +EXC'>0
SET @(RT_"""AEXC"","""_(COD_" ")_""","_DA_")")=""
+3 QUIT
KAEXC(ICD) ; Kill ROOT("AEXC",<code>,<ien>)
+1 if +($GET(DA))'>0
QUIT
NEW COD,EXC,RT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
SET COD=$PIECE($GET(@(RT_+DA_",0)")),"^",1)
if '$LENGTH(COD)
QUIT
+2 KILL @(RT_"""AEXC"","""_(COD_" ")_""","_DA_")")
+3 QUIT
+4 ;
+5 ; Miscellaneous
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
RM(ICD) ; Remove Main
+1 NEW IX,RT
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET IX=" "
FOR
SET IX=$ORDER(@(RT_""""_IX_""")"))
if '$LENGTH(IX)
QUIT
Begin DoDot:1
+3 KILL @(RT_""""_IX_""")")
End DoDot:1
+4 QUIT
RE(ICD) ; Re-Index
+1 NEW ZTQUEUED,DIK,IX,RT,DA
SET RT=$$RT(+($GET(ICD)))
if '$LENGTH(RT)
QUIT
+2 SET DIK=RT
SET ZTQUEUED=""
DO IXALL^DIK
+3 QUIT
RT(X) ; Root from File #
+1 QUIT $SELECT(+($GET(X))=80:$$ROOT^ICDEX(80),+($GET(X))=80.1:$$ROOT^ICDEX(80.1),1:"")
TM(X,Y) ; Trim Y
+1 SET X=$GET(X)
SET Y=$GET(Y)
if '$LENGTH(Y)
SET Y=" "
+2 FOR
if $EXTRACT(X,1)'=Y
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+3 FOR
if $EXTRACT(X,$LENGTH(X))'=Y
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+4 QUIT X
