Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEXAR8

LEXAR8.m

Go to the documentation of this file. 
  1. LEXAR8 ;ISL/KER - Look-up Response (CONCEPT USAGE update) ;05/23/2017
  1.  ;;2.0;LEXICON UTILITY;**103**;Sep 23, 1996;Build 2
  1.  ;               
  1.  ; Global Variables
  1.  ;    ^AUPNPROB("B")      ICR   1611
  1.  ;    ^LEX(757,           SACC 1.3
  1.  ;    ^LEX(757.001,       SACC 1.3
  1.  ;    ^LEX(757.01,        SACC 1.3
  1.  ;    ^LEX(757.02,        SACC 1.3
  1.  ;    ^LEX(757.1,         SACC 1.3
  1.  ;    ^TMP("LEXPL",$J)    SACC 2.3.2.5.1
  1.  ;               
  1.  ; External References
  1.  ;    HOME^%ZIS           ICR  10086
  1.  ;    ^%ZTLOAD            ICR  10063
  1.  ;    FILE^DIE            ICR   2053
  1.  ;    IX1^DIK             ICR  10013
  1.  ;    IX2^DIK             ICR  10013
  1.  ;    $$IENS^DILF         ICR   2054
  1.  ;    $$GET1^DIQ          ICR   2056
  1.  ;    $$CODEC^ICDEX       ICR   5747
  1.  ;    $$CSI^ICDEX         ICR   5747
  1.  ;    $$SAB^ICDEX         ICR   5747
  1.  ;    $$DT^XLFDT          ICR  10103
  1.  ;    $$UP^XLFSTR         ICR  10104
  1.  ;               
  1. UPDT ; Update CONCEPT USAGE file 757.001 (TaskMan)
  1.  N X,Y,ZTQUEUED,ZTREQ,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTPRI,LEXENV
  1.  S LEXENV=$$ENV Q:+LEXENV'>0  S ZTRTN="UPD^LEXAR8",ZTPRI=4,ZTIO="",ZTDTH=$H
  1.  S ZTDESC="Update CONCEPT USAGE file 757.001 from the Problem List"
  1.  D:$D(LEXTEST) @ZTRTN D:'$D(LEXTEST) ^%ZTLOAD
  1.  I +($G(ZTSK))>0,'$D(XPDENV),'$D(LEXBUILD),'$D(LEXIGHF),'$D(LEXREQP) D
  1.  . W !,"CONCEPT USAGE update tasked (Task #"_+($G(ZTSK))_"). "
  1.  Q
  1. UPD ;   Update CONCEPT USAGE file 757.001 (using Problem List)
  1.  K ^TMP("LEXPL",$J) N LEXNOT,LEXIIEN,LEXTD,LEXCT S LEXCT=0 S LEXNOT(5570)="",LEXNOT(521774)=""
  1.  S LEXTD=$$DT^XLFDT,LEXIIEN=0 F  S LEXIIEN=$O(^AUPNPROB("B",LEXIIEN)) Q:+LEXIIEN'>0  D
  1.  . N LEXPIEN S LEXPIEN=0 F  S LEXPIEN=$O(^AUPNPROB("B",LEXIIEN,LEXPIEN)) Q:+LEXPIEN'>0  D
  1.  . . N LEXLEX,LEXSCTC,LEXSTA,LEXSIEN
  1.  . . Q:$D(LEXNOT(+LEXIIEN))
  1.  . . S LEXCOD=$$CODEC^ICDEX(80,LEXIIEN) I $L(LEXCOD) D
  1.  . . . S LEXSYS=$$CSI^ICDEX(80,LEXIIEN) Q:"^1^30^"'[("^"_LEXSYS_"^")
  1.  . . . S LEXSAB=$E($$SAB^ICDEX(LEXSYS),1,3) Q:"^ICD^10D^"'[("^"_LEXSAB_"^")
  1.  . . . S LEXSTA=$$STATCHK^LEXSRC2(LEXCOD,LEXTD,,LEXSAB)
  1.  . . . S LEXSIEN=$P(LEXSTA,"^",2) Q:+LEXSIEN'>0
  1.  . . . S ^TMP("LEXPL",$J,"ICD",LEXSIEN)=+($G(^TMP("LEXPL",$J,"ICD",LEXSIEN)))+1
  1.  . . . S:'$D(^TMP("LEXPL",$J,"ICD",LEXSIEN,"SAB")) ^TMP("LEXPL",$J,"ICD",LEXSIEN,"SAB")=LEXSAB
  1.  . . . S:LEXSAB="10D" ^TMP("LEXPL",$J,"ICD",LEXSIEN,"SAB")=LEXSAB
  1.  . . S LEXCOD=$$GET1^DIQ(9000011,LEXPIEN,80001) I $L(LEXCOD) D
  1.  . . . S LEXSTA=$$STATCHK^LEXSRC2(LEXCOD,LEXTD,,"SCT")
  1.  . . . S LEXSIEN=$P(LEXSTA,"^",2) Q:+LEXSIEN'>0
  1.  . . . S ^TMP("LEXPL",$J,"SCT",LEXSIEN)=+($G(^TMP("LEXPL",$J,"SCT",LEXSIEN)))+1
  1.  . . . S ^TMP("LEXPL",$J,"SCT",LEXSIEN,"SAB")="SCT"
  1.  S LEXSIEN=0 F  S LEXSIEN=$O(^TMP("LEXPL",$J,"ICD",LEXSIEN)) Q:+LEXSIEN'>0  D
  1.  . N LEXCOD,LEXNOD,LEXFRQ,LEXSYS,LEXSAB,LEXDES,LEXSTA,LEXORG,LEXEIEN,LEXMIEN,LEXNEW
  1.  . S LEXNOD=$G(^LEX(757.02,+LEXSIEN,0)),LEXEIEN=+LEXNOD Q:+LEXEIEN'>0  Q:"^1^30^"'[("^"_$P(LEXNOD,"^",3)_"^")
  1.  . S LEXMIEN=+($P($G(LEXNOD),"^",4)) I LEXMIEN'>0 K ^TMP("LEXPL",$J,"ICD",LEXSIEN) Q
  1.  . S ^TMP("LEXPL",$J,"ICD","MC",LEXMIEN)=""
  1.  . S LEXSAB=$G(^TMP("LEXPL",$J,"ICD",LEXSIEN,"SAB")),LEXORG=$$ORIG(LEXMIEN)
  1.  . S LEXFRQ=$G(^TMP("LEXPL",$J,"ICD",LEXSIEN))
  1.  . S LEXNEW=LEXFRQ+LEXORG
  1.  . D UPDF(+LEXMIEN,"PL ICD",+LEXORG,+LEXNEW)
  1.  S LEXSIEN=0 F  S LEXSIEN=$O(^TMP("LEXPL",$J,"SCT",LEXSIEN)) Q:+LEXSIEN'>0  D
  1.  . N LEXCOD,LEXNOD,LEXFRQ,LEXSYS,LEXSAB,LEXDES,LEXSTA,LEXORG,LEXEIEN,LEXMIEN,LEXNEW
  1.  . S LEXNOD=$G(^LEX(757.02,+LEXSIEN,0)),LEXEIEN=+LEXNOD Q:+LEXEIEN'>0  Q:$P(LEXNOD,"^",3)'=56
  1.  . S LEXMIEN=+($P($G(LEXNOD),"^",4)) I LEXMIEN'>0 K ^TMP("LEXPL",$J,"SCT",LEXSIEN) Q
  1.  . S ^TMP("LEXPL",$J,"SCT","MC",LEXMIEN)=""
  1.  . S LEXSAB="SCT",LEXORG=$$ORIG(LEXMIEN),LEXFRQ=$G(^TMP("LEXPL",$J,"SCT",LEXSIEN)),LEXNEW=LEXFRQ+LEXORG
  1.  . D UPDF(+LEXMIEN,"PL SCT",+LEXORG,+LEXNEW)
  1.  F LEXSAB="ICD","10D","SCT" D
  1.  . N LEXS,LEXSIEN S LEXS=$S(LEXSAB="ICD":"SY ICD",LEXSAB="10D":"SY ICD",LEXSAB="SCT":"SY SCT",1:("SY "_LEXSAB))
  1.  . S LEXS="Update "_LEXS,LEXSIEN=0 F  S LEXSIEN=$O(^LEX(757.02,"ASRC",LEXSAB,LEXSIEN)) Q:+LEXSIEN'>0  D
  1.  . . N LEXMIEN,LEXORG,LEXFRQ,LEXEIEN,LEXND S LEXMIEN=+($P($G(^LEX(757.02,+LEXSIEN,0)),"^",4)) Q:+LEXMIEN'>0
  1.  . . Q:$D(^TMP("LEXPL",$J,"ICD","MC",LEXMIEN))!($D(^TMP("LEXPL",$J,"SCT","MC",LEXMIEN)))
  1.  . . S LEXEIEN=+($P($G(^LEX(757,+LEXMIEN,0)),"^",1)) Q:LEXEIEN'>0
  1.  . . Q:$P($G(^LEX(757.01,+LEXEIEN,1)),"^",5)>0
  1.  . . S (LEXORG,LEXFRQ)=$$ORIG(LEXMIEN) S LEXND=LEXMIEN_"^"_LEXORG_"^"_LEXFRQ
  1.  . . I $G(^LEX(757.001,+LEXMIEN,0))'=LEXND D UPDF(+LEXMIEN,LEXS,+LEXORG,+LEXFRQ)
  1.  W:'$D(ZTQUEUED)&(+($G(LEXCT))>0) !!,+($G(LEXCT))," changes made"
  1.  W:'$D(ZTQUEUED)&(+($G(LEXCT))'>0) !!,"No changes made" K ^TMP("LEXPL",$J)
  1.  Q
  1. UPDF(M,S,X,Y) ;   Update CONCEPT USAGE file 757.001 (FileMan)
  1.  N DA,LEXBUILD,LEXERR,LEXFDA,LEXFRQ,LEXOFQ,LEXIENS,LEXIGHF,LEXMIEN,LEXNEW,LEXOLD,LEXORG,LEXREQP,LEXS,XPDENV
  1.  S LEXMIEN=+($G(M)),LEXS=$G(X),LEXORG=$G(X),LEXFRQ=$G(Y) Q:LEXMIEN'>0  Q:'$D(^LEX(757.001,+LEXMIEN,0))
  1.  Q:+($G(^LEX(757.001,+LEXMIEN,0)))'=+LEXMIEN  Q:$D(^TMP("LEXPL",$J,"MAJ",LEXMIEN))  Q:LEXORG'?1N.N  Q:LEXFRQ'?1N.N
  1.  S LEXOFQ=+($P($G(^LEX(757.001,+LEXMIEN,0)),"^",3)) S DA=+LEXMIEN
  1.  S LEXIENS=$$IENS^DILF(.DA) S LEXFDA(757.001,LEXIENS,.01)=+LEXMIEN,LEXFDA(757.001,LEXIENS,1)=+LEXORG
  1.  S LEXNEW=+LEXMIEN_"^"_+LEXORG_"^"_+LEXFRQ,LEXOLD=$G(^LEX(757.001,+LEXMIEN,0)) Q:LEXNEW=LEXOLD
  1.  S LEXFDA(757.001,LEXIENS,2)=+LEXFRQ K LEXERR D FILE^DIE(,"LEXFDA","LEXERR")
  1.  S:'$D(LEXERR) LEXCT=+($G(LEXCT))+1 S ^TMP("LEXPL",$J,"MAJ",LEXMIEN)="" I $D(LEXTEST)&('$D(ZTQUEUED)) D
  1.  . N LEXID S LEXID=$G(LEXS) W !,LEXS,?15,LEXMIEN,?25,LEXORG,?30,LEXFRQ
  1.  . I LEXOFQ?1N.N,LEXOFQ'=LEXFRQ W ?35,"(formerly ",LEXOFQ,")"
  1.  Q
  1.  ;
  1. CLEART ; Set the Frequency to the Original Value (TaskMan)
  1.  N X,Y,ZTQUEUED,ZTREQ,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTPRI,LEXENV
  1.  S LEXENV=$$ENV Q:+LEXENV'>0  S ZTRTN="CLEAR^LEXAR8",ZTPRI=4,ZTIO="",ZTDTH=$H
  1.  S ZTDESC="Update CONCEPT USAGE file 757.001 from the Problem List"
  1.  D:$D(LEXTEST) @ZTRTN D:'$D(LEXTEST) ^%ZTLOAD
  1.  I +($G(ZTSK))>0,'$D(XPDENV),'$D(LEXBUILD),'$D(LEXIGHF),'$D(LEXREQP) D
  1.  . W !,"CONCEPT USAGE update tasked (Task #"_+($G(ZTSK))_"). "
  1.  Q
  1. CLEAR ; Set the Frequency to the Original Value
  1.  N LEXCT,LEXMIEN S (LEXCT,LEXMIEN)=0 F  S LEXMIEN=$O(^LEX(757,LEXMIEN)) Q:+LEXMIEN'>0  D
  1.  . N LEXORG,LEXFRQ,LEXOLD,LEXOFQ,LEXND S (LEXORG,LEXFRQ)=$$ORIG(+LEXMIEN)
  1.  . S LEXND=+LEXMIEN_"^"_+LEXORG_"^"_+LEXFRQ
  1.  . S LEXOLD=$G(^LEX(757.001,+LEXMIEN,0)),LEXOFQ=$P(LEXOLD,"^",3)
  1.  . I LEXOLD'=LEXND D EDIT(+LEXMIEN,"Clear",+LEXORG,+LEXFRQ)
  1.  K ^TMP("LEXPL",$J) W:'$D(ZTQUEUED)&(+($G(LEXCT))>0) !!,+($G(LEXCT))," changes made"
  1.  W:'$D(ZTQUEUED)&(+($G(LEXCT))'>0) !!,"No changes made"
  1.  Q
  1.  ;
  1. POPT ; Populate the Original Value (ONLY) (TaskMan)
  1.  N X,Y,ZTQUEUED,ZTREQ,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTPRI,LEXENV
  1.  S LEXENV=$$ENV Q:+LEXENV'>0  S ZTRTN="POP^LEXAR8",ZTPRI=4,ZTIO="",ZTDTH=$H
  1.  S ZTDESC="Update CONCEPT USAGE file 757.001 from the Problem List"
  1.  D:$D(LEXTEST) @ZTRTN D:'$D(LEXTEST) ^%ZTLOAD
  1.  I +($G(ZTSK))>0,'$D(XPDENV),'$D(LEXBUILD),'$D(LEXIGHF),'$D(LEXREQP) D
  1.  . W !,"CONCEPT USAGE update tasked (Task #"_+($G(ZTSK))_"). "
  1.  Q
  1. POP ; Populate the Original Value (ONLY)
  1.  N LEXCT,LEXMIEN S (LEXCT,LEXMIEN)=0 F  S LEXMIEN=$O(^LEX(757,LEXMIEN)) Q:+LEXMIEN'>0  D
  1.  . N LEXORG,LEXFRQ,LEXDIF,LEXND
  1.  . I '$D(^LEX(757.001,+LEXMIEN,0)) D  Q
  1.  . . N LEXORG,LEXFRQ,LEXND S (LEXORG,LEXFRQ)=$$ORIG(+LEXMIEN) S LEXND=+LEXMIEN_"^"_+LEXORG_"^"_+LEXFRQ
  1.  . . N DA,DIK S DA=+LEXMIEN,DIK="^LEX(757.001," D IX2^DIK S ^LEX(757.001,+LEXMIEN,0)=LEXND
  1.  . . N DA,DIK S DA=+LEXMIEN,DIK="^LEX(757.001," D IX1^DIK S LEXCT=LEXCT+1
  1.  . . I $D(LEXTEST)&('$D(ZTQUEUED)) D
  1.  . . . W !,"Populate",?15,LEXMIEN,?25,LEXORG,?30,LEXFRQ,?35,"(new)"
  1.  . S LEXND=$G(^LEX(757.001,+LEXMIEN,0)),LEXORG=$P(LEXND,"^",2),LEXFRQ=$P(LEXND,"^",2)
  1.  . S LEXDIF=LEXFRQ-LEXORG S:LEXDIF<0 LEXDIF=0
  1.  . S (LEXORG,LEXFRQ)=$$ORIG(+LEXMIEN),LEXFRQ=LEXFRQ+LEXDIF
  1.  . S LEXND=+LEXMIEN_"^"_+LEXORG_"^"_+LEXFRQ
  1.  . I $G(^LEX(757.001,+LEXMIEN,0))'=LEXND D
  1.  . . N DA,DIK,LEXOLD,LEXNEW S LEXOLD=$P($G(^LEX(757.001,+LEXMIEN,0)),"^",3),LEXNEW=+LEXFRQ
  1.  . . S DA=+LEXMIEN,DIK="^LEX(757.001," D IX2^DIK
  1.  . . S ^LEX(757.001,+LEXMIEN,0)=LEXND
  1.  . . N DA,DIK S DA=+LEXMIEN,DIK="^LEX(757.001," D IX1^DIK S LEXCT=LEXCT+1
  1.  . . I $D(LEXTEST)&('$D(ZTQUEUED)) D
  1.  . . . W !,"Populate",?15,LEXMIEN,?25,LEXORG
  1.  . . . W:LEXNEW?1N.N&(LEXOLD?1N.N)&(LEXNEW'=LEXOLD) ?35,"(formerly ",LEXOLD,")"
  1.  K ^TMP("LEXPL",$J) W:'$D(ZTQUEUED)&(+($G(LEXCT))>0) !!,+($G(LEXCT))," changes made"
  1.  W:'$D(ZTQUEUED)&(+($G(LEXCT))'>0) !!,"No changes made"
  1.  Q
  1.  ;
  1. EDIT(M,S,X,Y) ;   Edit CONCEPT USAGE file 757.001 (FileMan)
  1.  ;     M   Major Concept IEN
  1.  ;     S   System/Type of Edit
  1.  ;     X   Originating Value
  1.  ;     Y   Frequency
  1.  N LEXERR,LEXFRQ,LEXID,LEXMIEN,LEXNEW,LEXOFQ,LEXOLD,LEXORG,LEXS
  1.  S LEXMIEN=+($G(M)),LEXS=$G(X),LEXORG=$G(X),LEXFRQ=$G(Y) Q:LEXMIEN'>0  Q:'$D(^LEX(757.001,+LEXMIEN,0))
  1.  Q:+($G(^LEX(757.001,+LEXMIEN,0)))'=+LEXMIEN  Q:$D(^TMP("LEXPL",$J,"MAJ",LEXMIEN))  Q:LEXORG'?1N.N  Q:LEXFRQ'?1N.N
  1.  S LEXOFQ=+($P($G(^LEX(757.001,+LEXMIEN,0)),"^",3)),LEXNEW=+LEXMIEN_"^"_+LEXORG_"^"_+LEXFRQ
  1.  S LEXOLD=$G(^LEX(757.001,+LEXMIEN,0)) Q:LEXNEW=LEXOLD  K LEXERR I $D(^LEX(757.001,+LEXMIEN,0)) D
  1.  . N DA,LEXDA,LEXERR,LEXFDA,LEXIENS S DA=+LEXMIEN,LEXIENS=$$IENS^DILF(.DA),LEXFDA(757.001,LEXIENS,.01)=+LEXMIEN
  1.  . S LEXFDA(757.001,LEXIENS,1)=+LEXORG,LEXFDA(757.001,LEXIENS,2)=+LEXFRQ K LEXERR D FILE^DIE(,"LEXFDA","LEXERR")
  1.  . S:'$D(LEXERR)&($D(LEXCT)) LEXCT=+($G(LEXCT))+1
  1.  I '$D(^LEX(757.001,+LEXMIEN,0)) D
  1.  . N DA,LEXDA,LEXERR,LEXFDA,LEXIENS S LEXDA(1)=+LEXMIEN,LEXFDA(757.001,"+1,",.01)=+LEXMIEN,LEXFDA(757.001,"+1,",1)=+LEXORG
  1.  . S LEXFDA(757.001,"+1,",2)=+LEXFRQ K LEXERR D UPDATE^DIE(,"LEXFDA","LEXDA","LEXERR") S LEXOFQ=""
  1.  . S:'$D(LEXERR)&($D(LEXCT)) LEXCT=+($G(LEXCT))+1
  1.  S ^TMP("LEXPL",$J,"MAJ",LEXMIEN)="" I $D(LEXTEST)&('$D(ZTQUEUED)) D
  1.  . S LEXS=$G(LEXS) W !,LEXS,?15,LEXMIEN,?25,LEXORG,?30,LEXFRQ I LEXOFQ?1N.N,LEXOFQ'=LEXFRQ W ?35,"(formerly ",LEXOFQ,")"
  1.  Q
  1.  ;
  1. ORIG(X) ;   Get frequency based on codes and semantics
  1.  N LEXBD,LEXCL,LEXFS,LEXMIEN,LEXNOD,LEXSAB,LEXSCT,LEXSM,LEXSO,LEXTIEN,LEXTX S LEXMIEN=+($G(X)) Q:'$D(^LEX(757,LEXMIEN,0)) 0
  1.  S (X,LEXFS,LEXSO,LEXSM)=0 S LEXTIEN=0 F  S LEXTIEN=$O(^LEX(757.02,"AMC",LEXMIEN,LEXTIEN)) Q:+LEXTIEN=0  D
  1.  . N LEXNOD,LEXSAB,LEXCL S LEXNOD=$G(^LEX(757.02,LEXTIEN,0)),LEXSAB=+($P(LEXNOD,U,3)) Q:LEXSAB'>0
  1.  . ;     Coding Systems
  1.  . ;       ICD-10-CM                   6
  1.  . ;       ICD-10-PCS                  5
  1.  . S:LEXSAB=30 LEXCL=6 S:LEXSAB=31 LEXCL=5
  1.  . ;       ICD-9-CM                    4
  1.  . ;       DSM III/IV                  3
  1.  . S:LEXSAB=6 LEXCL=3 S:LEXSAB=5 LEXCL=3
  1.  . ;       ICD-9 Proc                  2
  1.  . S:LEXSAB=1 LEXCL=4 S:LEXSAB=2 LEXCL=2
  1.  . ;       CPT/HCPCS                   2
  1.  . S:LEXSAB=3 LEXCL=2 S:LEXSAB=4 LEXCL=2
  1.  . ;       Nursing                     1
  1.  . S:LEXSAB>10&(LEXSAB<16) LEXCL=1
  1.  . S:+($G(LEXCL))>LEXSO LEXSO=+($G(LEXCL))
  1.  S LEXTIEN=0 F  S LEXTIEN=$O(^LEX(757.1,"B",LEXMIEN,LEXTIEN)) Q:+LEXTIEN=0  D
  1.  . N LEXCL,LEXBD S LEXBD=+($P($G(^LEX(757.1,LEXTIEN,0)),U,2)),LEXCL=0
  1.  . ;     Semantic Map
  1.  . ;       Semantic Behavior           3
  1.  . S:LEXBD=3&(+($G(LEXCL))'>0) LEXCL="3^Behavior"
  1.  . ;       Semantic Disease/Disorder   3
  1.  . S:LEXBD=6 LEXCL="3^Disease/Disorder" S:LEXCL>LEXSM LEXSM=LEXCL
  1.  S LEXTIEN=0 F  S LEXTIEN=$O(^LEX(757.01,"AMC",+LEXMIEN,LEXTIEN)) Q:+LEXTIEN'>0  D
  1.  . Q:$P($G(^LEX(757.01,+LEXTIEN,1)),"^",2)'=8  N LEXTX,LEXSCT S LEXTX=$$UP^XLFSTR($G(^LEX(757.01,+LEXTIEN,0))),LEXSCT=0
  1.  . ;     SNOMED Hierarchy
  1.  . ;       SNOMED Disease/Disorder     4
  1.  . S:LEXTX["(DISORDER" LEXSCT="4^Disorder" S:LEXTX["(FINDING" LEXSCT="4^Finding"
  1.  . S:LEXTX["(MORPHOLOGIC ABNORMALITY" LEXSCT="4^Morphologic Abnormality"
  1.  . S:LEXTX["(ORGANISM" LEXSCT="4^Organism"
  1.  . ;       SNOMED Procedure            2
  1.  . S:+($G(LEXSCT))'>0&(LEXTX["(PROCEDURE") LEXSCT="2^Procedure"
  1.  . S:+LEXSCT>LEXFS LEXFS=LEXSCT
  1.  S X=+LEXSO S:X'>0 X=+LEXSM S:+LEXFS>X X=+LEXFS
  1.  Q X
  1.  ;
  1. INC(X) ; Increment Expression
  1.  ;
  1.  ; Input     
  1.  ;     
  1.  ;    X       IEN of the EXPRESSIONS file 757.01
  1.  ;        
  1.  ; Output    
  1.  ;     
  1.  ;    None
  1.  ;     
  1.  ;    This API increments the frequency of use value in the 
  1.  ;    CONCEPT USAGE file #757.001.  This value is used to 
  1.  ;    position the most frequently used terms at the top of 
  1.  ;    the selection list.
  1.  ;     
  1.  N LEXEIEN,LEXMIEN,LEXMC,LEXOR,LEXFQ,DA,DIK
  1.  S LEXEIEN=+($G(X)) Q:'$D(^LEX(757.01,+LEXEIEN,0))  S LEXMIEN=+($G(^LEX(757.01,+LEXEIEN,1)))
  1.  Q:'$D(^LEX(757,+LEXMIEN,0))  Q:'$D(^LEX(757.001,+LEXMIEN,0))
  1.  S LEXMC=+($P($G(^LEX(757.001,+LEXMIEN,0)),"^",1)),LEXOR=+($P($G(^LEX(757.001,+LEXMIEN,0)),"^",2))
  1.  S LEXFQ=+($P($G(^LEX(757.001,+LEXMIEN,0)),"^",3))+1 Q:LEXMC'=LEXMIEN
  1.  S DA=LEXMIEN,DIK="^LEX(757.001," D IX2^DIK
  1.  S ^LEX(757.001,+LEXMIEN,0)=LEXMC_"^"_LEXOR_"^"_LEXFQ
  1.  S DA=LEXMIEN,DIK="^LEX(757.001," D IX1^DIK
  1.  Q
  1.  ;
  1.  ; Miscellaneous
  1. ENV(X) ;   Check environment
  1.  N LEXNM,LEXTEST S DT=$$DT^XLFDT D HOME^%ZIS S U="^"
  1.  I +($G(DUZ))=0 W !!,?5,"DUZ not defined" Q 0
  1.  S LEXNM=$$GET1^DIQ(200,(DUZ_","),.01)
  1.  I '$L(LEXNM) W !!,?5,"DUZ not valid" Q 0
  1.  Q 1