LEXQC5 ;ISL/KER - Query - Changes - Duplicate Text ;05/23/2017
;;2.0;LEXICON UTILITY;**103**;Sep 23, 1996;Build 2
;
; Global Variables
; ^DIC(81.3, ICR 4492
; ^ICD0( ICR 4486
; ^ICD9( ICR 4485
; ^ICPT( ICR 4489
;
; External References
; $$UP^XLFSTR ICR 10103
;
Q
DUPL(LEX,X,Y) ; Long Description is a Duplicate
;
; Input
; LEX File Number
; 80 ICD Diagnosis
; 80.1 ICD Procedures
; 81 CPT Procedures
; 81.3 Modifiers
; X Code IEN
; Y Long Description IEN
;
; Output
;
; $$DUPL Boolean value
;
; 1 Long Descriptions is a Duplicate
; 0 Long Descriptions is not a Duplicate
;
N LEXFI,LEXIEN,LEXI S LEXFI=$G(LEX) Q:"^80^80.1^81^81.3^"'[("^"_LEXFI_"^") 0
S LEXIEN=+($G(X)) Q:+LEXIEN'>0 0 S LEXI=+($G(Y)) Q:+LEXI'>0 0
Q:LEXFI=81 +($$CPTL(LEXIEN,LEXI)) Q:LEXFI=81.3 +($$MODL(LEXIEN,LEXI)) Q:LEXFI=80!(LEXFI=80.1) +($$ICDL(LEXFI,LEXIEN,LEXI))
Q 0
DUPS(LEX,X,Y) ; Short Description is a Duplicate
;
; Input
; LEX File Number
; 80 ICD Diagnosis
; 80.1 ICD Procedures
; 81 CPT Procedures
; 81.3 Modifiers
; X Code IEN
; Y Short Description IEN
;
; Output
;
; $$DUPL Boolean value
;
; 1 Short Descriptions is a Duplicate
; 0 Short Descriptions is not a Duplicate
;
N LEXFI,LEXIEN,LEXI S LEXFI=$G(LEX) Q:"^80^80.1^81^"'[("^"_LEXFI_"^") 0
S LEXIEN=+($G(X)) Q:+LEXIEN'>0 0 S LEXI=+($G(Y)) Q:+LEXI'>0 0
Q:LEXFI=81 +($$CPTS(LEXIEN,LEXI)) Q:LEXFI=81.3 +($$MODS(LEXIEN,LEXI)) Q:LEXFI=80!(LEXFI=80.1) +($$ICDS(LEXFI,LEXIEN,LEXI))
Q 0
;
; Coding System Text
CPTL(X,Y) ; CPT Long Description is a Duplicate
N LEXA1,LEXA2,LEXD1,LEXD2,LEXI,LEXI1,LEXI2,LEXIEN,LEXL,LEXT
S LEXIEN=+($G(X)) Q:'$D(^ICPT(+LEXIEN,0)) 0
S LEXI1=+($G(Y)) I +($G(LEXI1))'>0 D Q:'$D(^ICPT(+LEXIEN,62,+LEXI1,1)) 0
. S LEXD1=$O(^ICPT(+LEXIEN,62,"B"," "),-1),LEXI1=$O(^ICPT(+LEXIEN,62,"B",+LEXD1," "),-1)
S LEXD1=$G(^ICPT(+LEXIEN,62,+LEXI1,0)) Q:LEXD1'?7N 0
S LEXD2=$O(^ICPT(+LEXIEN,62,"B",+LEXD1),-1) Q:LEXD2'?7N 0 Q:LEXD1'>LEXD2
S LEXI2=$O(^ICPT(+LEXIEN,62,"B",+LEXD2," "),-1) Q:+LEXD2'>0 Q:'$D(^ICPT(+LEXIEN,62,+LEXI2,1)) 0
S LEXL=0 F S LEXL=$O(^ICPT(+LEXIEN,62,+LEXI1,1,LEXL)) Q:+LEXL'>0 D
. N LEXT,LEXI S LEXT=$G(^ICPT(+LEXIEN,62,+LEXI1,1,+LEXL,0)) Q:'$L($G(LEXT))
. S LEXI=$O(LEXA1(" "),-1)+1,LEXA1(+LEXI)=LEXT
S LEXL=0 F S LEXL=$O(^ICPT(+LEXIEN,62,+LEXI2,1,LEXL)) Q:+LEXL'>0 D
. N LEXT,LEXI S LEXT=$G(^ICPT(+LEXIEN,62,+LEXI2,1,+LEXL,0)) Q:'$L($G(LEXT))
. S LEXI=$O(LEXA2(" "),-1)+1,LEXA2(+LEXI)=LEXT
S X=+($$SAME(.LEXA1,.LEXA2))
Q X
CPTS(X,Y) ; CPT Short Description is a Duplicate
N LEXA1,LEXA2,LEXD1,LEXD2,LEXI1,LEXI2,LEXIEN,LEXL
S LEXIEN=+($G(X)) Q:'$D(^ICPT(+LEXIEN,0)) 0
S LEXI1=+($G(Y)) I +($G(LEXI1))'>0 D Q:'$D(^ICPT(+LEXIEN,61,+LEXI1,0)) 0
. S LEXD1=+($O(^ICPT(+LEXIEN,61,"B"," "),-1)),LEXI1=$O(^ICPT(+LEXIEN,61,"B",+LEXD1," "),-1)
S LEXD1=$P($G(^ICPT(+LEXIEN,61,+LEXI1,0)),"^",1) Q:LEXD1'?7N 0
S LEXD2=$O(^ICPT(+LEXIEN,61,"B",+LEXD1),-1) Q:LEXD2'?7N 0 Q:LEXD1'>LEXD2 0
S LEXI2=$O(^ICPT(+LEXIEN,61,"B",+LEXD2," "),-1) Q:LEXI2'>0 Q:'$D(^ICPT(+LEXIEN,61,+LEXI2,0)) 0
S LEXA1=$$UP^XLFSTR($$TM($$DS($P($G(^ICPT(+LEXIEN,61,+LEXI1,0)),"^",2))))
S LEXA2=$$UP^XLFSTR($$TM($$DS($P($G(^ICPT(+LEXIEN,61,+LEXI2,0)),"^",2))))
Q:LEXA1'=LEXA2 0
Q 1
MODL(X,Y) ; Modifier Long Description is a Duplicate
N LEXA1,LEXA2,LEXD1,LEXD2,LEXI,LEXI1,LEXI2,LEXIEN,LEXL,LEXT
S LEXIEN=+($G(X)) Q:'$D(^DIC(81.3,+LEXIEN,0)) 0
S LEXI1=+($G(Y)) I +($G(LEXI1))'>0 D Q:'$D(^DIC(81.3,+LEXIEN,62,+LEXI1,1)) 0
. S LEXD1=$O(^DIC(81.3,+LEXIEN,62,"B"," "),-1),LEXI1=$O(^DIC(81.3,+LEXIEN,62,"B",+LEXD1," "),-1)
S LEXD1=$G(^DIC(81.3,+LEXIEN,62,+LEXI1,0)) Q:LEXD1'?7N 0
S LEXD2=$O(^DIC(81.3,+LEXIEN,62,"B",+LEXD1),-1) Q:LEXD2'?7N 0 Q:LEXD1'>LEXD2
S LEXI2=$O(^DIC(81.3,+LEXIEN,62,"B",+LEXD2," "),-1) Q:+LEXD2'>0 Q:'$D(^DIC(81.3,+LEXIEN,62,+LEXI2,1)) 0
S LEXL=0 F S LEXL=$O(^DIC(81.3,+LEXIEN,62,+LEXI1,1,LEXL)) Q:+LEXL'>0 D
. N LEXT,LEXI S LEXT=$G(^DIC(81.3,+LEXIEN,62,+LEXI1,1,+LEXL,0)) Q:'$L($G(LEXT))
. S LEXI=$O(LEXA1(" "),-1)+1,LEXA1(+LEXI)=LEXT
S LEXL=0 F S LEXL=$O(^DIC(81.3,+LEXIEN,62,+LEXI2,1,LEXL)) Q:+LEXL'>0 D
. N LEXT,LEXI S LEXT=$G(^DIC(81.3,+LEXIEN,62,+LEXI2,1,+LEXL,0)) Q:'$L($G(LEXT))
. S LEXI=$O(LEXA2(" "),-1)+1,LEXA2(+LEXI)=LEXT
S X=+($$SAME(.LEXA1,.LEXA2))
Q X
MODS(X,Y) ; Modifier Short Description is a Duplicate
N LEXA1,LEXA2,LEXD1,LEXD2,LEXI1,LEXI2,LEXIEN,LEXL
S LEXIEN=+($G(X)) Q:'$D(^DIC(81.3,+LEXIEN,0)) 0
S LEXI1=+($G(Y)) I +($G(LEXI1))'>0 D Q:'$D(^DIC(81.3,+LEXIEN,61,+LEXI1,0)) 0
. S LEXD1=+($O(^DIC(81.3,+LEXIEN,61,"B"," "),-1)),LEXI1=$O(^DIC(81.3,+LEXIEN,61,"B",+LEXD1," "),-1)
S LEXD1=$P($G(^DIC(81.3,+LEXIEN,61,+LEXI1,0)),"^",1) Q:LEXD1'?7N 0
S LEXD2=$O(^DIC(81.3,+LEXIEN,61,"B",+LEXD1),-1) Q:LEXD2'?7N 0 Q:LEXD1'>LEXD2 0
S LEXI2=$O(^DIC(81.3,+LEXIEN,61,"B",+LEXD2," "),-1) Q:LEXI2'>0 Q:'$D(^DIC(81.3,+LEXIEN,61,+LEXI2,0)) 0
S LEXA1=$$UP^XLFSTR($$TM($$DS($P($G(^DIC(81.3,+LEXIEN,61,+LEXI1,0)),"^",2))))
S LEXA2=$$UP^XLFSTR($$TM($$DS($P($G(^DIC(81.3,+LEXIEN,61,+LEXI2,0)),"^",2))))
Q:LEXA1'=LEXA2 0
Q 1
ICDL(LEX,X,Y) ; ICD Long Description is a Duplicate
N LEXIEN,LEXI1,LEXI2,LEXD1,LEXD2,LEXA1,LEXA2,LEXL,LEXRT,LEXFI
S LEXFI=+($G(LEX)) Q:"^80^80.1^"'[("^"_LEXFI_"^") 0
S LEXRT=$S(LEXFI=80:"^ICD9(",LEXFI=80.1:"^ICD0(",1:"") Q:'$L(LEXRT)
S LEXIEN=+($G(X)) Q:'$D(@(LEXRT_+LEXIEN_",0)")) 0
S LEXI1=+($G(Y)) I +($G(LEXI1))'>0 D Q:+($G(LEXI1))'>0 0
. S LEXD1=$O(@(LEXRT_+LEXIEN_",68,""B"","" "")"),-1) Q:LEXD1'?7N
. S LEXI1=$O(@(LEXRT_+LEXIEN_",68,""B"","_+LEXD1_","" "")"),-1)
Q:'$D(@(LEXRT_+LEXIEN_",68,"_+LEXI1_",0)")) 0 Q:'$D(@(LEXRT_+LEXIEN_",68,"_+LEXI1_",1)")) 0
S LEXD1=$P($G(@(LEXRT_+LEXIEN_",68,"_+LEXI1_",0)")),"^",1) Q:LEXD1'?7N
S LEXD2=$O(@(LEXRT_+LEXIEN_",68,""B"","_+LEXD1_")"),-1) Q:LEXD2'?7N 0
S LEXI2=$O(@(LEXRT_+LEXIEN_",68,""B"","_+LEXD2_","" "")"),-1) Q:LEXI2'>0 0
Q:'$D(@(LEXRT_+LEXIEN_",68,"_+LEXI2_",0)")) 0 Q:'$D(@(LEXRT_+LEXIEN_",68,"_+LEXI2_",1)")) 0
S LEXA1=$$UP^XLFSTR($$TM($$DS($P($G(@(LEXRT_+LEXIEN_",68,"_+LEXI1_",1)")),"^",1))))
S LEXA2=$$UP^XLFSTR($$TM($$DS($P($G(@(LEXRT_+LEXIEN_",68,"_+LEXI2_",1)")),"^",1))))
Q:LEXA1=LEXA2 1
Q 0
ICDS(LEX,X,Y) ; ICD Short Description is a Duplicate
N LEXIEN,LEXI1,LEXI2,LEXD1,LEXD2,LEXA1,LEXA2,LEXL,LEXRT,LEXFI
S LEXFI=+($G(LEX)) Q:"^80^80.1^"'[("^"_LEXFI_"^") 0
S LEXRT=$S(LEXFI=80:"^ICD9(",LEXFI=80.1:"^ICD0(",1:"") Q:'$L(LEXRT)
S LEXIEN=+($G(X)) Q:'$D(@(LEXRT_+LEXIEN_",0)")) 0
S LEXI1=+($G(Y)) I +($G(LEXI1))'>0 D Q:+($G(LEXI1))'>0 0
. S LEXD1=$O(@(LEXRT_+LEXIEN_",68,""B"","" "")"),-1) Q:LEXD1'?7N
. S LEXI1=$O(@(LEXRT_+LEXIEN_",68,""B"","_+LEXD1_","" "")"),-1)
Q:'$D(@(LEXRT_+LEXIEN_",68,"_+LEXI1_",0)")) 0 Q:'$D(@(LEXRT_+LEXIEN_",68,"_+LEXI1_",1)")) 0
S LEXD1=$P($G(@(LEXRT_+LEXIEN_",68,"_+LEXI1_",0)")),"^",1) Q:LEXD1'?7N
S LEXD2=$O(@(LEXRT_+LEXIEN_",68,""B"","_+LEXD1_")"),-1) Q:LEXD2'?7N 0
S LEXI2=$O(@(LEXRT_+LEXIEN_",68,""B"","_+LEXD2_","" "")"),-1) Q:LEXI2'>0 0
Q:'$D(@(LEXRT_+LEXIEN_",68,"_+LEXI2_",0)")) 0 Q:'$D(@(LEXRT_+LEXIEN_",68,"_+LEXI2_",1)")) 0
S LEXA1=$$UP^XLFSTR($$TM($$DS($P($G(@(LEXRT_+LEXIEN_",68,"_+LEXI1_",1)")),"^",1))))
S LEXA2=$$UP^XLFSTR($$TM($$DS($P($G(@(LEXRT_+LEXIEN_",68,"_+LEXI2_",1)")),"^",1))))
Q:LEXA1=LEXA2 1
Q 0
;
; Miscellaneous
SAME(X1,X2) ; Are Arrays X1 and X2 the same
Q:$O(X1(" "),-1)'>0 "-1^Invalid Array" Q:$O(X2(" "),-1)'>0 "-1^Invalid Array"
D PR^LEXU(.X1,80),PR^LEXU(.X2,80) N LEXSAME,LEXTIEN
S LEXSAME=1,LEXTIEN=0 F S LEXTIEN=$O(X1(LEXTIEN)) Q:+LEXTIEN'>0 S:$G(X1(+LEXTIEN))'=$G(X2(+LEXTIEN)) LEXSAME=0
I LEXSAME=1 S LEXTIEN=0 F S LEXTIEN=$O(X2(LEXTIEN)) Q:+LEXTIEN'>0 S:$G(X2(+LEXTIEN))'=$G(X1(+LEXTIEN)) LEXSAME=0
Q LEXSAME
DS(X) ; Remove Double Space
S X=$G(X) Q:X="" X
F Q:X'[" " S X=$P(X," ",1)_" "_$P(X," ",2,4000)
Q X
TM(X,Y) ; Trim Character Y - Default " " Space
S X=$G(X) Q:X="" X S 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[HLEXQC5 8460 printed Dec 13, 2024@02:08:26 Page 2
LEXQC5 ;ISL/KER - Query - Changes - Duplicate Text ;05/23/2017
+1 ;;2.0;LEXICON UTILITY;**103**;Sep 23, 1996;Build 2
+2 ;
+3 ; Global Variables
+4 ; ^DIC(81.3, ICR 4492
+5 ; ^ICD0( ICR 4486
+6 ; ^ICD9( ICR 4485
+7 ; ^ICPT( ICR 4489
+8 ;
+9 ; External References
+10 ; $$UP^XLFSTR ICR 10103
+11 ;
+12 QUIT
DUPL(LEX,X,Y) ; Long Description is a Duplicate
+1 ;
+2 ; Input
+3 ; LEX File Number
+4 ; 80 ICD Diagnosis
+5 ; 80.1 ICD Procedures
+6 ; 81 CPT Procedures
+7 ; 81.3 Modifiers
+8 ; X Code IEN
+9 ; Y Long Description IEN
+10 ;
+11 ; Output
+12 ;
+13 ; $$DUPL Boolean value
+14 ;
+15 ; 1 Long Descriptions is a Duplicate
+16 ; 0 Long Descriptions is not a Duplicate
+17 ;
+18 NEW LEXFI,LEXIEN,LEXI
SET LEXFI=$GET(LEX)
if "^80^80.1^81^81.3^"'[("^"_LEXFI_"^")
QUIT 0
+19 SET LEXIEN=+($GET(X))
if +LEXIEN'>0
QUIT 0
SET LEXI=+($GET(Y))
if +LEXI'>0
QUIT 0
+20 if LEXFI=81
QUIT +($$CPTL(LEXIEN,LEXI))
if LEXFI=81.3
QUIT +($$MODL(LEXIEN,LEXI))
if LEXFI=80!(LEXFI=80.1)
QUIT +($$ICDL(LEXFI,LEXIEN,LEXI))
+21 QUIT 0
DUPS(LEX,X,Y) ; Short Description is a Duplicate
+1 ;
+2 ; Input
+3 ; LEX File Number
+4 ; 80 ICD Diagnosis
+5 ; 80.1 ICD Procedures
+6 ; 81 CPT Procedures
+7 ; 81.3 Modifiers
+8 ; X Code IEN
+9 ; Y Short Description IEN
+10 ;
+11 ; Output
+12 ;
+13 ; $$DUPL Boolean value
+14 ;
+15 ; 1 Short Descriptions is a Duplicate
+16 ; 0 Short Descriptions is not a Duplicate
+17 ;
+18 NEW LEXFI,LEXIEN,LEXI
SET LEXFI=$GET(LEX)
if "^80^80.1^81^"'[("^"_LEXFI_"^")
QUIT 0
+19 SET LEXIEN=+($GET(X))
if +LEXIEN'>0
QUIT 0
SET LEXI=+($GET(Y))
if +LEXI'>0
QUIT 0
+20 if LEXFI=81
QUIT +($$CPTS(LEXIEN,LEXI))
if LEXFI=81.3
QUIT +($$MODS(LEXIEN,LEXI))
if LEXFI=80!(LEXFI=80.1)
QUIT +($$ICDS(LEXFI,LEXIEN,LEXI))
+21 QUIT 0
+22 ;
+23 ; Coding System Text
CPTL(X,Y) ; CPT Long Description is a Duplicate
+1 NEW LEXA1,LEXA2,LEXD1,LEXD2,LEXI,LEXI1,LEXI2,LEXIEN,LEXL,LEXT
+2 SET LEXIEN=+($GET(X))
if '$DATA(^ICPT(+LEXIEN,0))
QUIT 0
+3 SET LEXI1=+($GET(Y))
IF +($GET(LEXI1))'>0
Begin DoDot:1
+4 SET LEXD1=$ORDER(^ICPT(+LEXIEN,62,"B"," "),-1)
SET LEXI1=$ORDER(^ICPT(+LEXIEN,62,"B",+LEXD1," "),-1)
End DoDot:1
if '$DATA(^ICPT(+LEXIEN,62,+LEXI1,1))
QUIT 0
+5 SET LEXD1=$GET(^ICPT(+LEXIEN,62,+LEXI1,0))
if LEXD1'?7N
QUIT 0
+6 SET LEXD2=$ORDER(^ICPT(+LEXIEN,62,"B",+LEXD1),-1)
if LEXD2'?7N
QUIT 0
if LEXD1'>LEXD2
QUIT
+7 SET LEXI2=$ORDER(^ICPT(+LEXIEN,62,"B",+LEXD2," "),-1)
if +LEXD2'>0
QUIT
if '$DATA(^ICPT(+LEXIEN,62,+LEXI2,1))
QUIT 0
+8 SET LEXL=0
FOR
SET LEXL=$ORDER(^ICPT(+LEXIEN,62,+LEXI1,1,LEXL))
if +LEXL'>0
QUIT
Begin DoDot:1
+9 NEW LEXT,LEXI
SET LEXT=$GET(^ICPT(+LEXIEN,62,+LEXI1,1,+LEXL,0))
if '$LENGTH($GET(LEXT))
QUIT
+10 SET LEXI=$ORDER(LEXA1(" "),-1)+1
SET LEXA1(+LEXI)=LEXT
End DoDot:1
+11 SET LEXL=0
FOR
SET LEXL=$ORDER(^ICPT(+LEXIEN,62,+LEXI2,1,LEXL))
if +LEXL'>0
QUIT
Begin DoDot:1
+12 NEW LEXT,LEXI
SET LEXT=$GET(^ICPT(+LEXIEN,62,+LEXI2,1,+LEXL,0))
if '$LENGTH($GET(LEXT))
QUIT
+13 SET LEXI=$ORDER(LEXA2(" "),-1)+1
SET LEXA2(+LEXI)=LEXT
End DoDot:1
+14 SET X=+($$SAME(.LEXA1,.LEXA2))
+15 QUIT X
CPTS(X,Y) ; CPT Short Description is a Duplicate
+1 NEW LEXA1,LEXA2,LEXD1,LEXD2,LEXI1,LEXI2,LEXIEN,LEXL
+2 SET LEXIEN=+($GET(X))
if '$DATA(^ICPT(+LEXIEN,0))
QUIT 0
+3 SET LEXI1=+($GET(Y))
IF +($GET(LEXI1))'>0
Begin DoDot:1
+4 SET LEXD1=+($ORDER(^ICPT(+LEXIEN,61,"B"," "),-1))
SET LEXI1=$ORDER(^ICPT(+LEXIEN,61,"B",+LEXD1," "),-1)
End DoDot:1
if '$DATA(^ICPT(+LEXIEN,61,+LEXI1,0))
QUIT 0
+5 SET LEXD1=$PIECE($GET(^ICPT(+LEXIEN,61,+LEXI1,0)),"^",1)
if LEXD1'?7N
QUIT 0
+6 SET LEXD2=$ORDER(^ICPT(+LEXIEN,61,"B",+LEXD1),-1)
if LEXD2'?7N
QUIT 0
if LEXD1'>LEXD2
QUIT 0
+7 SET LEXI2=$ORDER(^ICPT(+LEXIEN,61,"B",+LEXD2," "),-1)
if LEXI2'>0
QUIT
if '$DATA(^ICPT(+LEXIEN,61,+LEXI2,0))
QUIT 0
+8 SET LEXA1=$$UP^XLFSTR($$TM($$DS($PIECE($GET(^ICPT(+LEXIEN,61,+LEXI1,0)),"^",2))))
+9 SET LEXA2=$$UP^XLFSTR($$TM($$DS($PIECE($GET(^ICPT(+LEXIEN,61,+LEXI2,0)),"^",2))))
+10 if LEXA1'=LEXA2
QUIT 0
+11 QUIT 1
MODL(X,Y) ; Modifier Long Description is a Duplicate
+1 NEW LEXA1,LEXA2,LEXD1,LEXD2,LEXI,LEXI1,LEXI2,LEXIEN,LEXL,LEXT
+2 SET LEXIEN=+($GET(X))
if '$DATA(^DIC(81.3,+LEXIEN,0))
QUIT 0
+3 SET LEXI1=+($GET(Y))
IF +($GET(LEXI1))'>0
Begin DoDot:1
+4 SET LEXD1=$ORDER(^DIC(81.3,+LEXIEN,62,"B"," "),-1)
SET LEXI1=$ORDER(^DIC(81.3,+LEXIEN,62,"B",+LEXD1," "),-1)
End DoDot:1
if '$DATA(^DIC(81.3,+LEXIEN,62,+LEXI1,1))
QUIT 0
+5 SET LEXD1=$GET(^DIC(81.3,+LEXIEN,62,+LEXI1,0))
if LEXD1'?7N
QUIT 0
+6 SET LEXD2=$ORDER(^DIC(81.3,+LEXIEN,62,"B",+LEXD1),-1)
if LEXD2'?7N
QUIT 0
if LEXD1'>LEXD2
QUIT
+7 SET LEXI2=$ORDER(^DIC(81.3,+LEXIEN,62,"B",+LEXD2," "),-1)
if +LEXD2'>0
QUIT
if '$DATA(^DIC(81.3,+LEXIEN,62,+LEXI2,1))
QUIT 0
+8 SET LEXL=0
FOR
SET LEXL=$ORDER(^DIC(81.3,+LEXIEN,62,+LEXI1,1,LEXL))
if +LEXL'>0
QUIT
Begin DoDot:1
+9 NEW LEXT,LEXI
SET LEXT=$GET(^DIC(81.3,+LEXIEN,62,+LEXI1,1,+LEXL,0))
if '$LENGTH($GET(LEXT))
QUIT
+10 SET LEXI=$ORDER(LEXA1(" "),-1)+1
SET LEXA1(+LEXI)=LEXT
End DoDot:1
+11 SET LEXL=0
FOR
SET LEXL=$ORDER(^DIC(81.3,+LEXIEN,62,+LEXI2,1,LEXL))
if +LEXL'>0
QUIT
Begin DoDot:1
+12 NEW LEXT,LEXI
SET LEXT=$GET(^DIC(81.3,+LEXIEN,62,+LEXI2,1,+LEXL,0))
if '$LENGTH($GET(LEXT))
QUIT
+13 SET LEXI=$ORDER(LEXA2(" "),-1)+1
SET LEXA2(+LEXI)=LEXT
End DoDot:1
+14 SET X=+($$SAME(.LEXA1,.LEXA2))
+15 QUIT X
MODS(X,Y) ; Modifier Short Description is a Duplicate
+1 NEW LEXA1,LEXA2,LEXD1,LEXD2,LEXI1,LEXI2,LEXIEN,LEXL
+2 SET LEXIEN=+($GET(X))
if '$DATA(^DIC(81.3,+LEXIEN,0))
QUIT 0
+3 SET LEXI1=+($GET(Y))
IF +($GET(LEXI1))'>0
Begin DoDot:1
+4 SET LEXD1=+($ORDER(^DIC(81.3,+LEXIEN,61,"B"," "),-1))
SET LEXI1=$ORDER(^DIC(81.3,+LEXIEN,61,"B",+LEXD1," "),-1)
End DoDot:1
if '$DATA(^DIC(81.3,+LEXIEN,61,+LEXI1,0))
QUIT 0
+5 SET LEXD1=$PIECE($GET(^DIC(81.3,+LEXIEN,61,+LEXI1,0)),"^",1)
if LEXD1'?7N
QUIT 0
+6 SET LEXD2=$ORDER(^DIC(81.3,+LEXIEN,61,"B",+LEXD1),-1)
if LEXD2'?7N
QUIT 0
if LEXD1'>LEXD2
QUIT 0
+7 SET LEXI2=$ORDER(^DIC(81.3,+LEXIEN,61,"B",+LEXD2," "),-1)
if LEXI2'>0
QUIT
if '$DATA(^DIC(81.3,+LEXIEN,61,+LEXI2,0))
QUIT 0
+8 SET LEXA1=$$UP^XLFSTR($$TM($$DS($PIECE($GET(^DIC(81.3,+LEXIEN,61,+LEXI1,0)),"^",2))))
+9 SET LEXA2=$$UP^XLFSTR($$TM($$DS($PIECE($GET(^DIC(81.3,+LEXIEN,61,+LEXI2,0)),"^",2))))
+10 if LEXA1'=LEXA2
QUIT 0
+11 QUIT 1
ICDL(LEX,X,Y) ; ICD Long Description is a Duplicate
+1 NEW LEXIEN,LEXI1,LEXI2,LEXD1,LEXD2,LEXA1,LEXA2,LEXL,LEXRT,LEXFI
+2 SET LEXFI=+($GET(LEX))
if "^80^80.1^"'[("^"_LEXFI_"^")
QUIT 0
+3 SET LEXRT=$SELECT(LEXFI=80:"^ICD9(",LEXFI=80.1:"^ICD0(",1:"")
if '$LENGTH(LEXRT)
QUIT
+4 SET LEXIEN=+($GET(X))
if '$DATA(@(LEXRT_+LEXIEN_",0)"))
QUIT 0
+5 SET LEXI1=+($GET(Y))
IF +($GET(LEXI1))'>0
Begin DoDot:1
+6 SET LEXD1=$ORDER(@(LEXRT_+LEXIEN_",68,""B"","" "")"),-1)
if LEXD1'?7N
QUIT
+7 SET LEXI1=$ORDER(@(LEXRT_+LEXIEN_",68,""B"","_+LEXD1_","" "")"),-1)
End DoDot:1
if +($GET(LEXI1))'>0
QUIT 0
+8 if '$DATA(@(LEXRT_+LEXIEN_",68,"_+LEXI1_",0)"))
QUIT 0
if '$DATA(@(LEXRT_+LEXIEN_",68,"_+LEXI1_",1)"))
QUIT 0
+9 SET LEXD1=$PIECE($GET(@(LEXRT_+LEXIEN_",68,"_+LEXI1_",0)")),"^",1)
if LEXD1'?7N
QUIT
+10 SET LEXD2=$ORDER(@(LEXRT_+LEXIEN_",68,""B"","_+LEXD1_")"),-1)
if LEXD2'?7N
QUIT 0
+11 SET LEXI2=$ORDER(@(LEXRT_+LEXIEN_",68,""B"","_+LEXD2_","" "")"),-1)
if LEXI2'>0
QUIT 0
+12 if '$DATA(@(LEXRT_+LEXIEN_",68,"_+LEXI2_",0)"))
QUIT 0
if '$DATA(@(LEXRT_+LEXIEN_",68,"_+LEXI2_",1)"))
QUIT 0
+13 SET LEXA1=$$UP^XLFSTR($$TM($$DS($PIECE($GET(@(LEXRT_+LEXIEN_",68,"_+LEXI1_",1)")),"^",1))))
+14 SET LEXA2=$$UP^XLFSTR($$TM($$DS($PIECE($GET(@(LEXRT_+LEXIEN_",68,"_+LEXI2_",1)")),"^",1))))
+15 if LEXA1=LEXA2
QUIT 1
+16 QUIT 0
ICDS(LEX,X,Y) ; ICD Short Description is a Duplicate
+1 NEW LEXIEN,LEXI1,LEXI2,LEXD1,LEXD2,LEXA1,LEXA2,LEXL,LEXRT,LEXFI
+2 SET LEXFI=+($GET(LEX))
if "^80^80.1^"'[("^"_LEXFI_"^")
QUIT 0
+3 SET LEXRT=$SELECT(LEXFI=80:"^ICD9(",LEXFI=80.1:"^ICD0(",1:"")
if '$LENGTH(LEXRT)
QUIT
+4 SET LEXIEN=+($GET(X))
if '$DATA(@(LEXRT_+LEXIEN_",0)"))
QUIT 0
+5 SET LEXI1=+($GET(Y))
IF +($GET(LEXI1))'>0
Begin DoDot:1
+6 SET LEXD1=$ORDER(@(LEXRT_+LEXIEN_",68,""B"","" "")"),-1)
if LEXD1'?7N
QUIT
+7 SET LEXI1=$ORDER(@(LEXRT_+LEXIEN_",68,""B"","_+LEXD1_","" "")"),-1)
End DoDot:1
if +($GET(LEXI1))'>0
QUIT 0
+8 if '$DATA(@(LEXRT_+LEXIEN_",68,"_+LEXI1_",0)"))
QUIT 0
if '$DATA(@(LEXRT_+LEXIEN_",68,"_+LEXI1_",1)"))
QUIT 0
+9 SET LEXD1=$PIECE($GET(@(LEXRT_+LEXIEN_",68,"_+LEXI1_",0)")),"^",1)
if LEXD1'?7N
QUIT
+10 SET LEXD2=$ORDER(@(LEXRT_+LEXIEN_",68,""B"","_+LEXD1_")"),-1)
if LEXD2'?7N
QUIT 0
+11 SET LEXI2=$ORDER(@(LEXRT_+LEXIEN_",68,""B"","_+LEXD2_","" "")"),-1)
if LEXI2'>0
QUIT 0
+12 if '$DATA(@(LEXRT_+LEXIEN_",68,"_+LEXI2_",0)"))
QUIT 0
if '$DATA(@(LEXRT_+LEXIEN_",68,"_+LEXI2_",1)"))
QUIT 0
+13 SET LEXA1=$$UP^XLFSTR($$TM($$DS($PIECE($GET(@(LEXRT_+LEXIEN_",68,"_+LEXI1_",1)")),"^",1))))
+14 SET LEXA2=$$UP^XLFSTR($$TM($$DS($PIECE($GET(@(LEXRT_+LEXIEN_",68,"_+LEXI2_",1)")),"^",1))))
+15 if LEXA1=LEXA2
QUIT 1
+16 QUIT 0
+17 ;
+18 ; Miscellaneous
SAME(X1,X2) ; Are Arrays X1 and X2 the same
+1 if $ORDER(X1(" "),-1)'>0
QUIT "-1^Invalid Array"
if $ORDER(X2(" "),-1)'>0
QUIT "-1^Invalid Array"
+2 DO PR^LEXU(.X1,80)
DO PR^LEXU(.X2,80)
NEW LEXSAME,LEXTIEN
+3 SET LEXSAME=1
SET LEXTIEN=0
FOR
SET LEXTIEN=$ORDER(X1(LEXTIEN))
if +LEXTIEN'>0
QUIT
if $GET(X1(+LEXTIEN))'=$GET(X2(+LEXTIEN))
SET LEXSAME=0
+4 IF LEXSAME=1
SET LEXTIEN=0
FOR
SET LEXTIEN=$ORDER(X2(LEXTIEN))
if +LEXTIEN'>0
QUIT
if $GET(X2(+LEXTIEN))'=$GET(X1(+LEXTIEN))
SET LEXSAME=0
+5 QUIT LEXSAME
DS(X) ; Remove Double Space
+1 SET X=$GET(X)
if X=""
QUIT X
+2 FOR
if X'[" "
QUIT
SET X=$PIECE(X," ",1)_" "_$PIECE(X," ",2,4000)
+3 QUIT X
TM(X,Y) ; Trim Character Y - Default " " Space
+1 SET X=$GET(X)
if X=""
QUIT 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
