- 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 Feb 18, 2025@23:34:28 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