LEXQC3 ;ISL/KER - Query - Changes - ICD/ICP/10D/10P ;05/23/2017
;;2.0;LEXICON UTILITY;**80,103**;Sep 23, 1996;Build 2
;
; 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
D:$D(^TMP("LEXQC",$J,LEXSAB)) UPC(LEXSAB)
Q
CE ; Check Entry
Q:'$L($G(LEXRT)) Q:+($G(LEXIEN))'>0
N LEX1,LEX2,LEX3,LEX4,LEX5,LEX6,LEX7,LEX8,LEXAEF,LEXAST,LEXBEF
N LEXBST,LEXCEF,LEXCST,LEXH,LEXND,LEXPEF,LEXPST,LEXQL,LEXSO,LEXSTID
S LEXCNT=LEXCNT+1 I LEXCNT'<+($G(LEXQSTR)) S LEXLC=+($G(LEXLC))+1 D
. W:'$D(ZTQUEUED)&('$D(LEXQUIET))&(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_")"))
; Short IEN Dupe
S LEX7=$O(@(LEXRT_+LEXIEN_",67,""B"","_+LEXCDT_","" "")"),-1),LEX7=$$DUPS^LEXQC5(81,LEXIEN,LEX7)
; Long IEN Dupe
S LEX8=$O(@(LEXRT_+LEXIEN_",68,""B"","_+LEXCDT_","" "")"),-1),LEX8=$$DUPL^LEXQC5(81,LEXIEN,LEX8)
; Activiation/Inactiviation/Re-Activation
; Has a current status and effective date
; Has a previous status and effective date
; Current status not equal to previous status
; Has a short description
; Has a long description
; Activation - current status >0
; Inactivatin - current status =0
; Reactivation - current status >0 past status =0
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)))
. S:'$D(^TMP("LEXQC",$J,LEXSAB,LEXSTID,1,(LEXSO_" "))) LEXCT=LEXCT+1
. S ^TMP("LEXQC",$J,LEXSAB,LEXSTID,1,(LEXSO_" "))=LEXO
. S ^TMP("LEXQC",$J,LEXSAB,LEXSTID,0)=LEXCT
; I Previous status (LEXPST) >0 and
; Short exist (LEX1) with a previous short (LEX3) and not a duplicate (LEX7) or
; long exist (LEX2) with a previous long (LEX4) and not a duplicate (LEX8)
I 'LEXQL I +LEXPST>0,((LEX1>0&(LEX3?7N)&(LEX7'>0))!(LEX2>0&(LEX4?7N)&(LEX8'>0))) 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)))
. S:'$D(^TMP("LEXQC",$J,LEXSAB,"REV",1,(LEXSO_" "))) LEXCT=LEXCT+1
. S ^TMP("LEXQC",$J,LEXSAB,"REV",1,(LEXSO_" "))=LEXO
. S ^TMP("LEXQC",$J,LEXSAB,"REV",0)=LEXCT
; Current status (LEXCST) exist and active
; Previous Status (LEXPST) exist and is active
; Short exist (LEX1) with a previous short (LEX3) and not a duplicate (LEX7) or
; long exist (LEX2) with a previous long (LEX4) and not a duplicate (LEX8)
I 'LEXQL S LEXQL=0 I ((LEXCEF?7N&(LEXCST>0))!(LEXPEF?7N&(LEXPST>0))),((LEX1>0&(LEX3?7N)&(LEX7'>0))!(LEX2>0&(LEX4?7N)&(LEX8'>0))) D
. N LEXCT,LEXO S LEXQL=1
. S LEXO=LEXIEN_"^"_LEXSO_"^"_LEXCDT
. S LEXCT=+($G(^TMP("LEXQC",$J,LEXSAB,"REU",0)))
. S:'$D(^TMP("LEXQC",$J,LEXSAB,"REU",1,(LEXSO_" "))) LEXCT=LEXCT+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
. N LEXCT,LEXO S LEXQL=1
. S LEXO=LEXIEN_"^"_LEXSO_"^"_LEXCDT
. S LEXCT=+($G(^TMP("LEXQC",$J,LEXSAB,"UPD",0)))
. S:'$D(^TMP("LEXQC",$J,LEXSAB,"UPD",1,(LEXSO_" "))) LEXCT=LEXCT+1
. S ^TMP("LEXQC",$J,LEXSAB,"UPD",1,(LEXSO_" "))=LEXO
. S ^TMP("LEXQC",$J,LEXSAB,"UPD",0)=LEXCT
N LEXQUIET
Q
UPC(X) ; Update Counters
N LEXSID,LEXACT,LEXORD,LEXCT S LEXSID=$G(X) Q:'$L(LEXSID)
S LEXACT="" F S LEXACT=$O(^TMP("LEXQC",$J,LEXSID,LEXACT)) Q:'$L(LEXACT) D
. S LEXCT=0,LEXORD="" F S LEXORD=$O(^TMP("LEXQC",$J,LEXSID,LEXACT,1,LEXORD)) Q:'$L(LEXORD) S LEXCT=LEXCT+1
. S ^TMP("LEXQC",$J,LEXSID,LEXACT,0)=LEXCT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXQC3 6575 printed Apr 09, 2024@21:10:42 Page 2
LEXQC3 ;ISL/KER - Query - Changes - ICD/ICP/10D/10P ;05/23/2017
+1 ;;2.0;LEXICON UTILITY;**80,103**;Sep 23, 1996;Build 2
+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 if $DATA(^TMP("LEXQC",$JOB,LEXSAB))
DO UPC(LEXSAB)
+14 QUIT
CE ; Check Entry
+1 if '$LENGTH($GET(LEXRT))
QUIT
if +($GET(LEXIEN))'>0
QUIT
+2 NEW LEX1,LEX2,LEX3,LEX4,LEX5,LEX6,LEX7,LEX8,LEXAEF,LEXAST,LEXBEF
+3 NEW LEXBST,LEXCEF,LEXCST,LEXH,LEXND,LEXPEF,LEXPST,LEXQL,LEXSO,LEXSTID
+4 SET LEXCNT=LEXCNT+1
IF LEXCNT'<+($GET(LEXQSTR))
SET LEXLC=+($GET(LEXLC))+1
Begin DoDot:1
+5 if '$DATA(ZTQUEUED)&('$DATA(LEXQUIET))&(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 ; Short IEN Dupe
+27 SET LEX7=$ORDER(@(LEXRT_+LEXIEN_",67,""B"","_+LEXCDT_","" "")"),-1)
SET LEX7=$$DUPS^LEXQC5(81,LEXIEN,LEX7)
+28 ; Long IEN Dupe
+29 SET LEX8=$ORDER(@(LEXRT_+LEXIEN_",68,""B"","_+LEXCDT_","" "")"),-1)
SET LEX8=$$DUPL^LEXQC5(81,LEXIEN,LEX8)
+30 ; Activiation/Inactiviation/Re-Activation
+31 ; Has a current status and effective date
+32 ; Has a previous status and effective date
+33 ; Current status not equal to previous status
+34 ; Has a short description
+35 ; Has a long description
+36 ; Activation - current status >0
+37 ; Inactivatin - current status =0
+38 ; Reactivation - current status >0 past status =0
+39 SET LEXQL=0
IF $LENGTH(LEXCST)
IF $LENGTH(LEXCEF)
Begin DoDot:1
+40 NEW LEXCT,LEXO
if $LENGTH(LEXBEF)&($LENGTH(LEXBST))&(LEXBST'=LEXCST)
QUIT
+41 if $LENGTH(LEXAEF)&($LENGTH(LEXAST))&(LEXAST'=LEXCST)
QUIT
+42 if (LEX1>0&(LEX3?7N))!(LEX2>0&(LEX4?7N))
QUIT
+43 NEW LEXSTID
if '$LENGTH($GET(LEXSO))
QUIT
SET LEXSTID=$SELECT(+LEXCST>0:"ACT",1:"INA")
+44 SET LEXQL=1
IF LEXSTID="ACT"
IF $GET(LEXPEF)?7N
IF +($GET(LEXPST))'>0
Begin DoDot:2
+45 IF +($GET(LEX5))'>0
IF +($GET(LEX6))'>0
SET LEXSTID="REA"
End DoDot:2
+46 SET LEXO=LEXIEN_"^"_LEXSO_"^"_LEXCDT
+47 SET LEXCT=+($GET(^TMP("LEXQC",$JOB,LEXSAB,LEXSTID,0)))
+48 if '$DATA(^TMP("LEXQC",$JOB,LEXSAB,LEXSTID,1,(LEXSO_" ")))
SET LEXCT=LEXCT+1
+49 SET ^TMP("LEXQC",$JOB,LEXSAB,LEXSTID,1,(LEXSO_" "))=LEXO
+50 SET ^TMP("LEXQC",$JOB,LEXSAB,LEXSTID,0)=LEXCT
End DoDot:1
+51 ; I Previous status (LEXPST) >0 and
+52 ; Short exist (LEX1) with a previous short (LEX3) and not a duplicate (LEX7) or
+53 ; long exist (LEX2) with a previous long (LEX4) and not a duplicate (LEX8)
+54 IF 'LEXQL
IF +LEXPST>0
IF ((LEX1>0&(LEX3?7N)&(LEX7'>0))!(LEX2>0&(LEX4?7N)&(LEX8'>0)))
Begin DoDot:1
+55 NEW LEXCT,LEXO
if '$LENGTH($GET(LEXSO))
QUIT
SET LEXQL=1
+56 SET LEXO=LEXIEN_"^"_LEXSO_"^"_LEXCDT
+57 SET LEXCT=+($GET(^TMP("LEXQC",$JOB,LEXSAB,"REV",0)))
+58 if '$DATA(^TMP("LEXQC",$JOB,LEXSAB,"REV",1,(LEXSO_" ")))
SET LEXCT=LEXCT+1
+59 SET ^TMP("LEXQC",$JOB,LEXSAB,"REV",1,(LEXSO_" "))=LEXO
+60 SET ^TMP("LEXQC",$JOB,LEXSAB,"REV",0)=LEXCT
End DoDot:1
+61 ; Current status (LEXCST) exist and active
+62 ; Previous Status (LEXPST) exist and is active
+63 ; Short exist (LEX1) with a previous short (LEX3) and not a duplicate (LEX7) or
+64 ; long exist (LEX2) with a previous long (LEX4) and not a duplicate (LEX8)
+65 IF 'LEXQL
SET LEXQL=0
IF ((LEXCEF?7N&(LEXCST>0))!(LEXPEF?7N&(LEXPST>0)))
IF ((LEX1>0&(LEX3?7N)&(LEX7'>0))!(LEX2>0&(LEX4?7N)&(LEX8'>0)))
Begin DoDot:1
+66 NEW LEXCT,LEXO
SET LEXQL=1
+67 SET LEXO=LEXIEN_"^"_LEXSO_"^"_LEXCDT
+68 SET LEXCT=+($GET(^TMP("LEXQC",$JOB,LEXSAB,"REU",0)))
+69 if '$DATA(^TMP("LEXQC",$JOB,LEXSAB,"REU",1,(LEXSO_" ")))
SET LEXCT=LEXCT+1
+70 SET ^TMP("LEXQC",$JOB,LEXSAB,"REU",1,(LEXSO_" "))=LEXO
+71 SET ^TMP("LEXQC",$JOB,LEXSAB,"REU",0)=LEXCT
End DoDot:1
+72 IF 'LEXQL
IF $DATA(@(LEXRT_+LEXIEN_",69,""B"","_+($GET(LEXCDT))_")"))
Begin DoDot:1
+73 NEW LEXCT,LEXO
SET LEXQL=1
+74 SET LEXO=LEXIEN_"^"_LEXSO_"^"_LEXCDT
+75 SET LEXCT=+($GET(^TMP("LEXQC",$JOB,LEXSAB,"UPD",0)))
+76 if '$DATA(^TMP("LEXQC",$JOB,LEXSAB,"UPD",1,(LEXSO_" ")))
SET LEXCT=LEXCT+1
+77 SET ^TMP("LEXQC",$JOB,LEXSAB,"UPD",1,(LEXSO_" "))=LEXO
+78 SET ^TMP("LEXQC",$JOB,LEXSAB,"UPD",0)=LEXCT
End DoDot:1
+79 NEW LEXQUIET
+80 QUIT
UPC(X) ; Update Counters
+1 NEW LEXSID,LEXACT,LEXORD,LEXCT
SET LEXSID=$GET(X)
if '$LENGTH(LEXSID)
QUIT
+2 SET LEXACT=""
FOR
SET LEXACT=$ORDER(^TMP("LEXQC",$JOB,LEXSID,LEXACT))
if '$LENGTH(LEXACT)
QUIT
Begin DoDot:1
+3 SET LEXCT=0
SET LEXORD=""
FOR
SET LEXORD=$ORDER(^TMP("LEXQC",$JOB,LEXSID,LEXACT,1,LEXORD))
if '$LENGTH(LEXORD)
QUIT
SET LEXCT=LEXCT+1
+4 SET ^TMP("LEXQC",$JOB,LEXSID,LEXACT,0)=LEXCT
End DoDot:1
+5 QUIT
