LEXWUD ;ISL/KER - Lexicon Keywords - Update (Dupes) ;05/23/2017
;;2.0;LEXICON UTILITY;**103**;Sep 23, 1996;Build 2
;
; Global Variables
; ^ICD0( ICR 4486
; ^ICD9( ICR 4485
; ^LEX(757.01, SACC 1.3
;
; External References
; HOME^%ZIS ICR 10086
; ^%ZTLOAD ICR 10063
; IX1^DIK ICR 10013
; ^DIK ICR 10013
; $$GET1^DIQ ICR 2056
; $$DT^XLFDT ICR 10103
;
Q
EN ; Main Entry Point (tasked)
N ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTQUEUED,ZTREQ,LEXRUN,LEXCHK,LEXNAM,I,X
I '$D(LEXTEST) S LEXRUN=$$RUN2^LEXWUM I LEXRUN>0 W:$L($P(LEXRUN,"^",2)) !,?4,$P(LEXRUN,"^",2),! Q
S (LEXNAM,ZTDESC)="Keyword Update Utility (Dupes)",LEXCHK=""
S ZTRTN="DUP^LEXWUD" S:$D(LEXTEST) ZTSAVE("LEXTEST")="" S ZTIO="",ZTDTH=$H
D:'$D(LEXTEST) ^%ZTLOAD D:$D(LEXTEST) @ZTRTN I +($G(ZTSK))>0 W !!,?4,$G(LEXNAM)," tasked (#",+($G(ZTSK)),")",!
D HOME^%ZIS K LEXTEST,LEXRUN,LEXNAM
Q
DUP ; Remove Duplicates
S:$D(ZTQUEUED) ZTREQ="@" D LEX,ICD
Q
LEX ; Lexicon Duplicates
N LEXRT,LEXIIEN S LEXIIEN=0 F S LEXIIEN=$O(^LEX(757.01,LEXIIEN)) Q:+LEXIIEN'>0 D
. N LEXSUP,LEXKEY,LEXFND K LEXSUP S LEXSIEN=0 F S LEXSIEN=$O(^LEX(757.01,LEXIIEN,5,LEXSIEN)) Q:+LEXSIEN'>0 D
. . N LEXKEY S LEXKEY=$G(^LEX(757.01,LEXIIEN,5,LEXSIEN,0)) Q:'$L(LEXKEY)
. . S LEXSUP(LEXKEY)=+($G(LEXSUP(LEXKEY)))+1
. Q:'$D(LEXSUP) S LEXKEY="" F S LEXKEY=$O(LEXSUP(LEXKEY)) Q:'$L(LEXKEY) D
. . I +($G(LEXSUP(LEXKEY)))'>1 K LEXSUP(LEXKEY) Q
. Q:'$D(LEXSUP) F S LEXFND=0 D Q:LEXFND'>0
. . S LEXKEY="" F S LEXKEY=$O(LEXSUP(LEXKEY)) Q:'$L(LEXKEY) D
. . . N LEXSIEN,LEXCNT S LEXCNT=+($G(LEXSUP(LEXKEY))),LEXSIEN=$O(^LEX(757.01,LEXIIEN,5,"B",LEXKEY," "),-1) Q:+LEXSIEN'>0
. . . I $D(LEXTEST) D
. . . . N LEXND S LEXND="^LEX(757.01,"_+LEXIIEN_",5,0)" W !!,LEXND,"=",@LEXND W:+($G(LEXCNT))>1 ?70,+($G(LEXCNT))
. . . . S LEXND="^LEX(757.01,"_+LEXIIEN_",5,"_+LEXSIEN_",0)" W !,LEXND,"=",@LEXND
. . . . S LEXND="^LEX(757.01,"_+LEXIIEN_",5,""B"","""_LEXKEY_""","_+LEXSIEN_")" W !,LEXND,"=",@LEXND
. . . I '$D(LEXTEST) D
. . . . N DA,DIK,LEXI,LEX3,LEX4,LEXV1,LEXV2 S DA(1)=LEXIIEN,DA=LEXSIEN,DIK="^LEX(757.01,"_DA(1)_",5," D ^DIK
. . . . S LEX3="",(LEX4,LEXI)=0 F S LEXI=$O(^LEX(757.01,LEXIIEN,5,LEXI)) Q:+LEXI'>0 D
. . . . . S LEX3=LEXI,LEX4=LEX4+1 N DA,DIK S DA(1)=LEXIIEN,DA=LEXI,DIK="^LEX(757.01,"_DA(1)_",5," D IX1^DIK
. . . . S ^LEX(757.01,LEXIIEN,5,0)="^757.18^"_LEX3_"^"_LEX4
. . . . S LEXV1="^LEX(757.01,"_+LEXIIEN_",5,""B"","""_LEXKEY_""",0)" S LEXV1=$O(@LEXV1)
. . . . S LEXV2="^LEX(757.01,"_+LEXIIEN_",5,""B"","""_LEXKEY_""","" "")" S LEXV2=$O(@LEXV2,-1)
. . . . S:+LEXV1>0&(LEXV2>0)&(LEXV1'=LEXV2) LEXFND=1
ICD ; ICD Duplicates (Diagnosis and Procedures)
N LEXRT F LEXRT="^ICD9(","^ICD0(" D
. N LEXIIEN,LEXFID S LEXFID=$S(LEXRT="^ICD9(":"80.682",LEXRT="^ICD0(":"80.1682",1:"") Q:'$L(LEXFID)
. S LEXIIEN=0 F S LEXIIEN=$O(@(LEXRT_+LEXIIEN_")")) Q:+LEXIIEN'>0 D
. . N LEXDIEN S LEXDIEN=0 F S LEXDIEN=$O(@(LEXRT_+LEXIIEN_",68,"_+LEXDIEN_")")) Q:+LEXDIEN'>0 D
. . . Q:'$D(@(LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,""B"")"))
. . . N LEXKEY,LEXSIEN,LEXSUP K LEXSUP
. . . S LEXSIEN=0 F S LEXSIEN=$O(@(LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,"_+LEXSIEN_")")) Q:+LEXSIEN'>0 D
. . . . N LEXKEY S LEXKEY=$G(@(LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,"_+LEXSIEN_",0)")) Q:'$L(LEXKEY)
. . . . S LEXSUP(LEXKEY)=+($G(LEXSUP(LEXKEY)))+1
. . . Q:'$D(LEXSUP) S LEXKEY="" F S LEXKEY=$O(LEXSUP(LEXKEY)) Q:'$L(LEXKEY) D
. . . . I +($G(LEXSUP(LEXKEY)))'>1 K LEXSUP(LEXKEY) Q
. . . Q:'$D(LEXSUP) F S LEXFND=0 D Q:LEXFND'>0
. . . . S LEXKEY="" F S LEXKEY=$O(LEXSUP(LEXKEY)) Q:'$L(LEXKEY) D
. . . . . N LEXSIEN,LEXCNT S LEXCNT=+($G(LEXSUP(LEXKEY)))
. . . . . S LEXSIEN=$O(@(LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,""B"","""_LEXKEY_""","" "")"),-1) Q:+LEXSIEN'>0
. . . . . I $D(LEXTEST) D
. . . . . . N LEXND S LEXND=LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,0)" W !!,LEXND,"=",@LEXND W:+($G(LEXCNT))>1 ?70,+($G(LEXCNT))
. . . . . . S LEXND=LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,"_+LEXSIEN_",0)" W !,LEXND,"=",@LEXND
. . . . . . S LEXND=LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,""B"","""_LEXKEY_""","_+LEXSIEN_")" W !,LEXND,"=",@LEXND
. . . . . I '$D(LEXTEST) D
. . . . . . N DA,DIK,LEXI,LEX3,LEX4,LEXV1,LEXV2 S DA(2)=LEXIIEN,DA(1)=LEXDIEN,DA=LEXSIEN
. . . . . . S DIK=LEXRT_DA(2)_",68,"_DA(1)_",2," D ^DIK
. . . . . . S LEX3="",(LEX4,LEXI)=0 F S LEXI=$O(@(LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,"_LEXI_")")) Q:+LEXI'>0 D
. . . . . . . S LEX3=LEXI,LEX4=LEX4+1 N DA,DIK
. . . . . . . S DA(2)=LEXIIEN,DA(1)=+LEXDIEN,DA=LEXI,DIK=LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2," D IX1^DIK
. . . . . . S @(LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,0)")="^"_LEXFID_"^"_LEX3_"^"_LEX4
. . . . . . S LEXV1=LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,""B"","""_LEXKEY_""",0)" S LEXV1=$O(@LEXV1)
. . . . . . S LEXV2=LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,""B"","""_LEXKEY_""","" "")" S LEXV2=$O(@LEXV2,-1)
. . . . . . S:+LEXV1>0&(LEXV2>0)&(LEXV1'=LEXV2) LEXFND=1
Q
;
; Miscelaneous
ENV(X) ; Environment
D HOME^%ZIS S U="^",DT=$$DT^XLFDT,DTIME=300 K POP
N LEXNM S LEXNM=$$GET1^DIQ(200,(DUZ_","),.01)
I '$L(LEXNM) W !!,?5,"Invalid/Missing DUZ" Q 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXWUD 5346 printed Apr 09, 2024@21:10:55 Page 2
LEXWUD ;ISL/KER - Lexicon Keywords - Update (Dupes) ;05/23/2017
+1 ;;2.0;LEXICON UTILITY;**103**;Sep 23, 1996;Build 2
+2 ;
+3 ; Global Variables
+4 ; ^ICD0( ICR 4486
+5 ; ^ICD9( ICR 4485
+6 ; ^LEX(757.01, SACC 1.3
+7 ;
+8 ; External References
+9 ; HOME^%ZIS ICR 10086
+10 ; ^%ZTLOAD ICR 10063
+11 ; IX1^DIK ICR 10013
+12 ; ^DIK ICR 10013
+13 ; $$GET1^DIQ ICR 2056
+14 ; $$DT^XLFDT ICR 10103
+15 ;
+16 QUIT
EN ; Main Entry Point (tasked)
+1 NEW ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTQUEUED,ZTREQ,LEXRUN,LEXCHK,LEXNAM,I,X
+2 IF '$DATA(LEXTEST)
SET LEXRUN=$$RUN2^LEXWUM
IF LEXRUN>0
if $LENGTH($PIECE(LEXRUN,"^",2))
WRITE !,?4,$PIECE(LEXRUN,"^",2),!
QUIT
+3 SET (LEXNAM,ZTDESC)="Keyword Update Utility (Dupes)"
SET LEXCHK=""
+4 SET ZTRTN="DUP^LEXWUD"
if $DATA(LEXTEST)
SET ZTSAVE("LEXTEST")=""
SET ZTIO=""
SET ZTDTH=$HOROLOG
+5 if '$DATA(LEXTEST)
DO ^%ZTLOAD
if $DATA(LEXTEST)
DO @ZTRTN
IF +($GET(ZTSK))>0
WRITE !!,?4,$GET(LEXNAM)," tasked (#",+($GET(ZTSK)),")",!
+6 DO HOME^%ZIS
KILL LEXTEST,LEXRUN,LEXNAM
+7 QUIT
DUP ; Remove Duplicates
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
DO LEX
DO ICD
+2 QUIT
LEX ; Lexicon Duplicates
+1 NEW LEXRT,LEXIIEN
SET LEXIIEN=0
FOR
SET LEXIIEN=$ORDER(^LEX(757.01,LEXIIEN))
if +LEXIIEN'>0
QUIT
Begin DoDot:1
+2 NEW LEXSUP,LEXKEY,LEXFND
KILL LEXSUP
SET LEXSIEN=0
FOR
SET LEXSIEN=$ORDER(^LEX(757.01,LEXIIEN,5,LEXSIEN))
if +LEXSIEN'>0
QUIT
Begin DoDot:2
+3 NEW LEXKEY
SET LEXKEY=$GET(^LEX(757.01,LEXIIEN,5,LEXSIEN,0))
if '$LENGTH(LEXKEY)
QUIT
+4 SET LEXSUP(LEXKEY)=+($GET(LEXSUP(LEXKEY)))+1
End DoDot:2
+5 if '$DATA(LEXSUP)
QUIT
SET LEXKEY=""
FOR
SET LEXKEY=$ORDER(LEXSUP(LEXKEY))
if '$LENGTH(LEXKEY)
QUIT
Begin DoDot:2
+6 IF +($GET(LEXSUP(LEXKEY)))'>1
KILL LEXSUP(LEXKEY)
QUIT
End DoDot:2
+7 if '$DATA(LEXSUP)
QUIT
FOR
SET LEXFND=0
Begin DoDot:2
+8 SET LEXKEY=""
FOR
SET LEXKEY=$ORDER(LEXSUP(LEXKEY))
if '$LENGTH(LEXKEY)
QUIT
Begin DoDot:3
+9 NEW LEXSIEN,LEXCNT
SET LEXCNT=+($GET(LEXSUP(LEXKEY)))
SET LEXSIEN=$ORDER(^LEX(757.01,LEXIIEN,5,"B",LEXKEY," "),-1)
if +LEXSIEN'>0
QUIT
+10 IF $DATA(LEXTEST)
Begin DoDot:4
+11 NEW LEXND
SET LEXND="^LEX(757.01,"_+LEXIIEN_",5,0)"
WRITE !!,LEXND,"=",@LEXND
if +($GET(LEXCNT))>1
WRITE ?70,+($GET(LEXCNT))
+12 SET LEXND="^LEX(757.01,"_+LEXIIEN_",5,"_+LEXSIEN_",0)"
WRITE !,LEXND,"=",@LEXND
+13 SET LEXND="^LEX(757.01,"_+LEXIIEN_",5,""B"","""_LEXKEY_""","_+LEXSIEN_")"
WRITE !,LEXND,"=",@LEXND
End DoDot:4
+14 IF '$DATA(LEXTEST)
Begin DoDot:4
+15 NEW DA,DIK,LEXI,LEX3,LEX4,LEXV1,LEXV2
SET DA(1)=LEXIIEN
SET DA=LEXSIEN
SET DIK="^LEX(757.01,"_DA(1)_",5,"
DO ^DIK
+16 SET LEX3=""
SET (LEX4,LEXI)=0
FOR
SET LEXI=$ORDER(^LEX(757.01,LEXIIEN,5,LEXI))
if +LEXI'>0
QUIT
Begin DoDot:5
+17 SET LEX3=LEXI
SET LEX4=LEX4+1
NEW DA,DIK
SET DA(1)=LEXIIEN
SET DA=LEXI
SET DIK="^LEX(757.01,"_DA(1)_",5,"
DO IX1^DIK
End DoDot:5
+18 SET ^LEX(757.01,LEXIIEN,5,0)="^757.18^"_LEX3_"^"_LEX4
+19 SET LEXV1="^LEX(757.01,"_+LEXIIEN_",5,""B"","""_LEXKEY_""",0)"
SET LEXV1=$ORDER(@LEXV1)
+20 SET LEXV2="^LEX(757.01,"_+LEXIIEN_",5,""B"","""_LEXKEY_""","" "")"
SET LEXV2=$ORDER(@LEXV2,-1)
+21 if +LEXV1>0&(LEXV2>0)&(LEXV1'=LEXV2)
SET LEXFND=1
End DoDot:4
End DoDot:3
End DoDot:2
if LEXFND'>0
QUIT
End DoDot:1
ICD ; ICD Duplicates (Diagnosis and Procedures)
+1 NEW LEXRT
FOR LEXRT="^ICD9(","^ICD0("
Begin DoDot:1
+2 NEW LEXIIEN,LEXFID
SET LEXFID=$SELECT(LEXRT="^ICD9(":"80.682",LEXRT="^ICD0(":"80.1682",1:"")
if '$LENGTH(LEXFID)
QUIT
+3 SET LEXIIEN=0
FOR
SET LEXIIEN=$ORDER(@(LEXRT_+LEXIIEN_")"))
if +LEXIIEN'>0
QUIT
Begin DoDot:2
+4 NEW LEXDIEN
SET LEXDIEN=0
FOR
SET LEXDIEN=$ORDER(@(LEXRT_+LEXIIEN_",68,"_+LEXDIEN_")"))
if +LEXDIEN'>0
QUIT
Begin DoDot:3
+5 if '$DATA(@(LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,""B"")"))
QUIT
+6 NEW LEXKEY,LEXSIEN,LEXSUP
KILL LEXSUP
+7 SET LEXSIEN=0
FOR
SET LEXSIEN=$ORDER(@(LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,"_+LEXSIEN_")"))
if +LEXSIEN'>0
QUIT
Begin DoDot:4
+8 NEW LEXKEY
SET LEXKEY=$GET(@(LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,"_+LEXSIEN_",0)"))
if '$LENGTH(LEXKEY)
QUIT
+9 SET LEXSUP(LEXKEY)=+($GET(LEXSUP(LEXKEY)))+1
End DoDot:4
+10 if '$DATA(LEXSUP)
QUIT
SET LEXKEY=""
FOR
SET LEXKEY=$ORDER(LEXSUP(LEXKEY))
if '$LENGTH(LEXKEY)
QUIT
Begin DoDot:4
+11 IF +($GET(LEXSUP(LEXKEY)))'>1
KILL LEXSUP(LEXKEY)
QUIT
End DoDot:4
+12 if '$DATA(LEXSUP)
QUIT
FOR
SET LEXFND=0
Begin DoDot:4
+13 SET LEXKEY=""
FOR
SET LEXKEY=$ORDER(LEXSUP(LEXKEY))
if '$LENGTH(LEXKEY)
QUIT
Begin DoDot:5
+14 NEW LEXSIEN,LEXCNT
SET LEXCNT=+($GET(LEXSUP(LEXKEY)))
+15 SET LEXSIEN=$ORDER(@(LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,""B"","""_LEXKEY_""","" "")"),-1)
if +LEXSIEN'>0
QUIT
+16 IF $DATA(LEXTEST)
Begin DoDot:6
+17 NEW LEXND
SET LEXND=LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,0)"
WRITE !!,LEXND,"=",@LEXND
if +($GET(LEXCNT))>1
WRITE ?70,+($GET(LEXCNT))
+18 SET LEXND=LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,"_+LEXSIEN_",0)"
WRITE !,LEXND,"=",@LEXND
+19 SET LEXND=LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,""B"","""_LEXKEY_""","_+LEXSIEN_")"
WRITE !,LEXND,"=",@LEXND
End DoDot:6
+20 IF '$DATA(LEXTEST)
Begin DoDot:6
+21 NEW DA,DIK,LEXI,LEX3,LEX4,LEXV1,LEXV2
SET DA(2)=LEXIIEN
SET DA(1)=LEXDIEN
SET DA=LEXSIEN
+22 SET DIK=LEXRT_DA(2)_",68,"_DA(1)_",2,"
DO ^DIK
+23 SET LEX3=""
SET (LEX4,LEXI)=0
FOR
SET LEXI=$ORDER(@(LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,"_LEXI_")"))
if +LEXI'>0
QUIT
Begin DoDot:7
+24 SET LEX3=LEXI
SET LEX4=LEX4+1
NEW DA,DIK
+25 SET DA(2)=LEXIIEN
SET DA(1)=+LEXDIEN
SET DA=LEXI
SET DIK=LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,"
DO IX1^DIK
End DoDot:7
+26 SET @(LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,0)")="^"_LEXFID_"^"_LEX3_"^"_LEX4
+27 SET LEXV1=LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,""B"","""_LEXKEY_""",0)"
SET LEXV1=$ORDER(@LEXV1)
+28 SET LEXV2=LEXRT_+LEXIIEN_",68,"_+LEXDIEN_",2,""B"","""_LEXKEY_""","" "")"
SET LEXV2=$ORDER(@LEXV2,-1)
+29 if +LEXV1>0&(LEXV2>0)&(LEXV1'=LEXV2)
SET LEXFND=1
End DoDot:6
End DoDot:5
End DoDot:4
if LEXFND'>0
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+30 QUIT
+31 ;
+32 ; Miscelaneous
ENV(X) ; Environment
+1 DO HOME^%ZIS
SET U="^"
SET DT=$$DT^XLFDT
SET DTIME=300
KILL POP
+2 NEW LEXNM
SET LEXNM=$$GET1^DIQ(200,(DUZ_","),.01)
+3 IF '$LENGTH(LEXNM)
WRITE !!,?5,"Invalid/Missing DUZ"
QUIT 0
+4 QUIT 1
