LEXQC3 ;ISL/KER - Query - Changes - ICD/ICP/10D/10P ;04/21/2014
;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
;
; Global Variables
; ^TMP("LEXQC") SACC 2.3.2.5.1
;
; External References
; $$FILE^ICDEX ICR 5747
; $$ROOT^ICDEX ICR 5747
; $$SINFO^ICDEX ICR 5747
;
; Local Variables NEWed in LEXQC
; LEXADT After Date
; LEXBDT Before Date
; LEXCDT Versioning Date
; LEXQLEN Length of Display
; LEXQSTR Length of String
; LEXQTOT Total Records
;
D09 ; ICD-9 Diagnosis Changes
D CK("80",1)
Q
P09 ; ICD-9 Procedure Changes
D CK("80.1",2)
Q
D10 ; ICD-10 Diagnosis Changes
D CK("80",30)
Q
P10 ; ICD-10 Procedure Changes
D CK("80.1",31)
Q
CK(X,Y) ; Check File X for Changes
N LEXFI,LEXRT,LEXSAB,LEXIDT,LEXSYS,LEXSINF S LEXFI=$$FILE^ICDEX($G(X)) Q:+LEXFI'>0
S LEXRT=$$ROOT^ICDEX(LEXFI) Q:$E(LEXRT,1)'="^" Q:$E(LEXRT,$L(LEXRT))'="(" Q:'$L($P($P(LEXRT,"^",2),"(",1))
S LEXSYS=+($G(Y)) Q:+LEXSYS'>0 S LEXSINF=$$SINFO^ICDEX(LEXSYS)
S LEXSAB=$P(LEXSINF,"^",3) Q:'$L(LEXSAB) S LEXIDT=$P(LEXSINF,"^",5)
S LEXCDT=$G(LEXCDT) Q:LEXCDT'?7N Q:LEXCDT<LEXIDT Q:$P($G(LEXBDT),".",1)'?7N
Q:$P($G(LEXADT),".",1)'?7N Q:+LEXCDT'>+LEXBDT K ^TMP("LEXQC",$J,LEXSAB) N LEX1,LEX2,LEX3
N LEX4,LEX5,LEX6,LEXAEF,LEXAST,LEXBEF,LEXBST,LEXCEF,LEXCNT,LEXCST
N LEXH,LEXIEN,LEXLC,LEXND,LEXORD,LEXPEF,LEXPST,LEXQL,LEXSO,LEXSTID
S LEXQLEN=+($G(LEXQLEN)),LEXQTOT=+($G(LEXQTOT))
S LEXQSTR=+($G(LEXQSTR)),LEXCNT=0,LEXLC=0
S LEXORD="" F S LEXORD=$O(@(LEXRT_"""ABA"","_+LEXSYS_","""_LEXORD_""")")) Q:'$L(LEXORD) D
. S LEXIEN=0 F S LEXIEN=$O(@(LEXRT_"""ABA"","_+LEXSYS_","""_LEXORD_""","_+LEXIEN_")")) Q:+LEXIEN'>0 D CE
Q
CE ; Check Entry
Q:'$L($G(LEXRT)) Q:+($G(LEXIEN))'>0
N LEX1,LEX2,LEX3,LEX4,LEXAEF,LEXAST,LEXBEF,LEXBST,LEXCEF,LEXCST,LEXH
N LEXND,LEXPEF,LEXPST,LEXQL,LEXSO,LEXSTID S LEXCNT=LEXCNT+1
I LEXCNT'<+($G(LEXQSTR)) D
. S LEXLC=+($G(LEXLC))+1 W:LEXLC'>+($G(LEXQLEN)) "." S LEXCNT=0
S LEXSO=$P($G(@(LEXRT_+LEXIEN_",0)")),"^",1) Q:'$L(LEXSO)
S LEXH=$O(@(LEXRT_+LEXIEN_",66,""B"","_+LEXCDT_","" "")"),-1)
S LEXND=$G(@(LEXRT_+LEXIEN_",66,"_+LEXH_",0)"))
S LEXCEF=$P(LEXND,"^",1),LEXCST=$P(LEXND,"^",2)
S LEXH=$O(@(LEXRT_+LEXIEN_",66,""B"","_+LEXBDT_","" "")"),-1)
S LEXND=$G(@(LEXRT_+LEXIEN_",66,"_+LEXH_",0)"))
S LEXBEF=$P(LEXND,"^",1),LEXBST=$P(LEXND,"^",2)
S LEXH=$O(@(LEXRT_+LEXIEN_",66,""B"","_+LEXADT_","" "")"),-1)
S LEXND=$G(@(LEXRT_+LEXIEN_",66,"_+LEXH_",0)"))
S LEXAEF=$P(LEXND,"^",1),LEXAST=$P(LEXND,"^",2)
S LEXH=$O(@(LEXRT_+LEXIEN_",66,""B"","_+LEXCDT_")"),-1)
S LEXH=$O(@(LEXRT_+LEXIEN_",66,""B"","_+LEXH_","" "")"),-1)
S LEXND=$G(@(LEXRT_+LEXIEN_",66,"_+LEXH_",0)"))
S LEXPEF=$P(LEXND,"^",1),LEXPST=$P(LEXND,"^",2)
S LEX1=$D(@(LEXRT_+LEXIEN_",67,""B"","_+LEXCDT_")"))>0
S LEX2=$D(@(LEXRT_+LEXIEN_",68,""B"","_+LEXCDT_")"))>0
S LEX3=$O(@(LEXRT_+LEXIEN_",67,""B"","_+LEXCDT_")"),-1)
S LEX4=$O(@(LEXRT_+LEXIEN_",68,""B"","_+LEXCDT_")"),-1)
S LEX5=$D(@(LEXRT_+LEXIEN_",67,""B"","_+LEXCDT_")"))
S LEX6=$D(@(LEXRT_+LEXIEN_",68,""B"","_+LEXCDT_")"))
S LEXQL=0 I $L(LEXCST),$L(LEXCEF) D
. N LEXCT,LEXO Q:$L(LEXBEF)&($L(LEXBST))&(LEXBST'=LEXCST)
. Q:$L(LEXAEF)&($L(LEXAST))&(LEXAST'=LEXCST)
. Q:(LEX1>0&(LEX3?7N))!(LEX2>0&(LEX4?7N))
. N LEXSTID Q:'$L($G(LEXSO)) S LEXSTID=$S(+LEXCST>0:"ACT",1:"INA")
. S LEXQL=1 I LEXSTID="ACT",$G(LEXPEF)?7N,+($G(LEXPST))'>0 D
. . I +($G(LEX5))'>0,+($G(LEX6))'>0 S LEXSTID="REA"
. S LEXO=LEXIEN_"^"_LEXSO_"^"_LEXCDT
. S LEXCT=+($G(^TMP("LEXQC",$J,LEXSAB,LEXSTID,0)))+1
. S ^TMP("LEXQC",$J,LEXSAB,LEXSTID,1,(LEXSO_" "))=LEXO
. S ^TMP("LEXQC",$J,LEXSAB,LEXSTID,0)=LEXCT
I 'LEXQL I +LEXPST>0,((LEX1>0&(LEX3?7N))!(LEX2>0&(LEX4?7N))) D
. N LEXCT,LEXO Q:'$L($G(LEXSO)) S LEXQL=1
. S LEXO=LEXIEN_"^"_LEXSO_"^"_LEXCDT
. S LEXCT=+($G(^TMP("LEXQC",$J,LEXSAB,"REV",0)))+1
. S ^TMP("LEXQC",$J,LEXSAB,"REV",1,(LEXSO_" "))=LEXO
. S ^TMP("LEXQC",$J,LEXSAB,"REV",0)=LEXCT
I 'LEXQL S LEXQL=0 I ((LEXCEF?7N&(LEXCST>0))!(LEXPEF?7N&(LEXPST>0))),((LEX1>0&(LEX3?7N))!(LEX2>0&(LEX4?7N))) D
. N LEXCT,LEXO S LEXQL=1
. S LEXO=LEXIEN_"^"_LEXSO_"^"_LEXCDT
. S LEXCT=+($G(^TMP("LEXQC",$J,LEXSAB,"REU",0)))+1
. S ^TMP("LEXQC",$J,LEXSAB,"REU",1,(LEXSO_" "))=LEXO
. S ^TMP("LEXQC",$J,LEXSAB,"REU",0)=LEXCT
I 'LEXQL I $D(@(LEXRT_+LEXIEN_",69,""B"","_+($G(LEXCDT))_")")) D
. ;^ICD9(+($G(LEXIEN)),69,"B",+($G(LEXCDT)))) D
. N LEXCT,LEXO S LEXQL=1
. S LEXO=LEXIEN_"^"_LEXSO_"^"_LEXCDT
. S LEXCT=+($G(^TMP("LEXQC",$J,LEXSAB,"UPD",0)))+1
. S ^TMP("LEXQC",$J,LEXSAB,"UPD",1,(LEXSO_" "))=LEXO
. S ^TMP("LEXQC",$J,LEXSAB,"UPD",0)=LEXCT
Q
LEXQC3 ;ISL/KER - Query - Changes - ICD/ICP/10D/10P ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXQC") SACC 2.3.2.5.1
+5 ;
+6 ; External References
+7 ; $$FILE^ICDEX ICR 5747
+8 ; $$ROOT^ICDEX ICR 5747
+9 ; $$SINFO^ICDEX ICR 5747
+10 ;
+11 ; Local Variables NEWed in LEXQC
+12 ; LEXADT After Date
+13 ; LEXBDT Before Date
+14 ; LEXCDT Versioning Date
+15 ; LEXQLEN Length of Display
+16 ; LEXQSTR Length of String
+17 ; LEXQTOT Total Records
+18 ;
D09 ; ICD-9 Diagnosis Changes
+1 DO CK("80",1)
+2 QUIT
P09 ; ICD-9 Procedure Changes
+1 DO CK("80.1",2)
+2 QUIT
D10 ; ICD-10 Diagnosis Changes
+1 DO CK("80",30)
+2 QUIT
P10 ; ICD-10 Procedure Changes
+1 DO CK("80.1",31)
+2 QUIT
CK(X,Y) ; Check File X for Changes
+1 NEW LEXFI,LEXRT,LEXSAB,LEXIDT,LEXSYS,LEXSINF
SET LEXFI=$$FILE^ICDEX($GET(X))
IF +LEXFI'>0
QUIT
+2 SET LEXRT=$$ROOT^ICDEX(LEXFI)
IF $EXTRACT(LEXRT,1)'="^"
QUIT
IF $EXTRACT(LEXRT,$LENGTH(LEXRT))'="("
QUIT
IF '$LENGTH($PIECE($PIECE(LEXRT,"^",2),"(",1))
QUIT
+3 SET LEXSYS=+($GET(Y))
IF +LEXSYS'>0
QUIT
SET LEXSINF=$$SINFO^ICDEX(LEXSYS)
+4 SET LEXSAB=$PIECE(LEXSINF,"^",3)
IF '$LENGTH(LEXSAB)
QUIT
SET LEXIDT=$PIECE(LEXSINF,"^",5)
+5 SET LEXCDT=$GET(LEXCDT)
IF LEXCDT'?7N
QUIT
IF LEXCDT<LEXIDT
QUIT
IF $PIECE($GET(LEXBDT),".",1)'?7N
QUIT
+6 IF $PIECE($GET(LEXADT),".",1)'?7N
QUIT
IF +LEXCDT'>+LEXBDT
QUIT
KILL ^TMP("LEXQC",$JOB,LEXSAB)
NEW LEX1,LEX2,LEX3
+7 NEW LEX4,LEX5,LEX6,LEXAEF,LEXAST,LEXBEF,LEXBST,LEXCEF,LEXCNT,LEXCST
+8 NEW LEXH,LEXIEN,LEXLC,LEXND,LEXORD,LEXPEF,LEXPST,LEXQL,LEXSO,LEXSTID
+9 SET LEXQLEN=+($GET(LEXQLEN))
SET LEXQTOT=+($GET(LEXQTOT))
+10 SET LEXQSTR=+($GET(LEXQSTR))
SET LEXCNT=0
SET LEXLC=0
+11 SET LEXORD=""
FOR
SET LEXORD=$ORDER(@(LEXRT_"""ABA"","_+LEXSYS_","""_LEXORD_""")"))
IF '$LENGTH(LEXORD)
QUIT
Begin DoDot:1
+12 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(@(LEXRT_"""ABA"","_+LEXSYS_","""_LEXORD_""","_+LEXIEN_")"))
IF +LEXIEN'>0
QUIT
DO CE
End DoDot:1
+13 QUIT
CE ; Check Entry
+1 IF '$LENGTH($GET(LEXRT))
QUIT
IF +($GET(LEXIEN))'>0
QUIT
+2 NEW LEX1,LEX2,LEX3,LEX4,LEXAEF,LEXAST,LEXBEF,LEXBST,LEXCEF,LEXCST,LEXH
+3 NEW LEXND,LEXPEF,LEXPST,LEXQL,LEXSO,LEXSTID
SET LEXCNT=LEXCNT+1
+4 IF LEXCNT'<+($GET(LEXQSTR))
Begin DoDot:1
+5 SET LEXLC=+($GET(LEXLC))+1
IF LEXLC'>+($GET(LEXQLEN))
WRITE "."
SET LEXCNT=0
End DoDot:1
+6 SET LEXSO=$PIECE($GET(@(LEXRT_+LEXIEN_",0)")),"^",1)
IF '$LENGTH(LEXSO)
QUIT
+7 SET LEXH=$ORDER(@(LEXRT_+LEXIEN_",66,""B"","_+LEXCDT_","" "")"),-1)
+8 SET LEXND=$GET(@(LEXRT_+LEXIEN_",66,"_+LEXH_",0)"))
+9 SET LEXCEF=$PIECE(LEXND,"^",1)
SET LEXCST=$PIECE(LEXND,"^",2)
+10 SET LEXH=$ORDER(@(LEXRT_+LEXIEN_",66,""B"","_+LEXBDT_","" "")"),-1)
+11 SET LEXND=$GET(@(LEXRT_+LEXIEN_",66,"_+LEXH_",0)"))
+12 SET LEXBEF=$PIECE(LEXND,"^",1)
SET LEXBST=$PIECE(LEXND,"^",2)
+13 SET LEXH=$ORDER(@(LEXRT_+LEXIEN_",66,""B"","_+LEXADT_","" "")"),-1)
+14 SET LEXND=$GET(@(LEXRT_+LEXIEN_",66,"_+LEXH_",0)"))
+15 SET LEXAEF=$PIECE(LEXND,"^",1)
SET LEXAST=$PIECE(LEXND,"^",2)
+16 SET LEXH=$ORDER(@(LEXRT_+LEXIEN_",66,""B"","_+LEXCDT_")"),-1)
+17 SET LEXH=$ORDER(@(LEXRT_+LEXIEN_",66,""B"","_+LEXH_","" "")"),-1)
+18 SET LEXND=$GET(@(LEXRT_+LEXIEN_",66,"_+LEXH_",0)"))
+19 SET LEXPEF=$PIECE(LEXND,"^",1)
SET LEXPST=$PIECE(LEXND,"^",2)
+20 SET LEX1=$DATA(@(LEXRT_+LEXIEN_",67,""B"","_+LEXCDT_")"))>0
+21 SET LEX2=$DATA(@(LEXRT_+LEXIEN_",68,""B"","_+LEXCDT_")"))>0
+22 SET LEX3=$ORDER(@(LEXRT_+LEXIEN_",67,""B"","_+LEXCDT_")"),-1)
+23 SET LEX4=$ORDER(@(LEXRT_+LEXIEN_",68,""B"","_+LEXCDT_")"),-1)
+24 SET LEX5=$DATA(@(LEXRT_+LEXIEN_",67,""B"","_+LEXCDT_")"))
+25 SET LEX6=$DATA(@(LEXRT_+LEXIEN_",68,""B"","_+LEXCDT_")"))
+26 SET LEXQL=0
IF $LENGTH(LEXCST)
IF $LENGTH(LEXCEF)
Begin DoDot:1
+27 NEW LEXCT,LEXO
IF $LENGTH(LEXBEF)&($LENGTH(LEXBST))&(LEXBST'=LEXCST)
QUIT
+28 IF $LENGTH(LEXAEF)&($LENGTH(LEXAST))&(LEXAST'=LEXCST)
QUIT
+29 IF (LEX1>0&(LEX3?7N))!(LEX2>0&(LEX4?7N))
QUIT
+30 NEW LEXSTID
IF '$LENGTH($GET(LEXSO))
QUIT
SET LEXSTID=$SELECT(+LEXCST>0:"ACT",1:"INA")
+31 SET LEXQL=1
IF LEXSTID="ACT"
IF $GET(LEXPEF)?7N
IF +($GET(LEXPST))'>0
Begin DoDot:2
+32 IF +($GET(LEX5))'>0
IF +($GET(LEX6))'>0
SET LEXSTID="REA"
End DoDot:2
+33 SET LEXO=LEXIEN_"^"_LEXSO_"^"_LEXCDT
+34 SET LEXCT=+($GET(^TMP("LEXQC",$JOB,LEXSAB,LEXSTID,0)))+1
+35 SET ^TMP("LEXQC",$JOB,LEXSAB,LEXSTID,1,(LEXSO_" "))=LEXO
+36 SET ^TMP("LEXQC",$JOB,LEXSAB,LEXSTID,0)=LEXCT
End DoDot:1
+37 IF 'LEXQL
IF +LEXPST>0
IF ((LEX1>0&(LEX3?7N))!(LEX2>0&(LEX4?7N)))
Begin DoDot:1
+38 NEW LEXCT,LEXO
IF '$LENGTH($GET(LEXSO))
QUIT
SET LEXQL=1
+39 SET LEXO=LEXIEN_"^"_LEXSO_"^"_LEXCDT
+40 SET LEXCT=+($GET(^TMP("LEXQC",$JOB,LEXSAB,"REV",0)))+1
+41 SET ^TMP("LEXQC",$JOB,LEXSAB,"REV",1,(LEXSO_" "))=LEXO
+42 SET ^TMP("LEXQC",$JOB,LEXSAB,"REV",0)=LEXCT
End DoDot:1
+43 IF 'LEXQL
SET LEXQL=0
IF ((LEXCEF?7N&(LEXCST>0))!(LEXPEF?7N&(LEXPST>0)))
IF ((LEX1>0&(LEX3?7N))!(LEX2>0&(LEX4?7N)))
Begin DoDot:1
+44 NEW LEXCT,LEXO
SET LEXQL=1
+45 SET LEXO=LEXIEN_"^"_LEXSO_"^"_LEXCDT
+46 SET LEXCT=+($GET(^TMP("LEXQC",$JOB,LEXSAB,"REU",0)))+1
+47 SET ^TMP("LEXQC",$JOB,LEXSAB,"REU",1,(LEXSO_" "))=LEXO
+48 SET ^TMP("LEXQC",$JOB,LEXSAB,"REU",0)=LEXCT
End DoDot:1
+49 IF 'LEXQL
IF $DATA(@(LEXRT_+LEXIEN_",69,""B"","_+($GET(LEXCDT))_")"))
Begin DoDot:1
+50 ;^ICD9(+($G(LEXIEN)),69,"B",+($G(LEXCDT)))) D
+51 NEW LEXCT,LEXO
SET LEXQL=1
+52 SET LEXO=LEXIEN_"^"_LEXSO_"^"_LEXCDT
+53 SET LEXCT=+($GET(^TMP("LEXQC",$JOB,LEXSAB,"UPD",0)))+1
+54 SET ^TMP("LEXQC",$JOB,LEXSAB,"UPD",1,(LEXSO_" "))=LEXO
+55 SET ^TMP("LEXQC",$JOB,LEXSAB,"UPD",0)=LEXCT
End DoDot:1
+56 QUIT
