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

LEXRXF.m

Go to the documentation of this file.
  1. LEXRXF ;ISL/KER - Re-Index 757.21 B/C/AA ;05/23/2017
  1. ;;2.0;LEXICON UTILITY;**81,80,103**;Sep 23, 1996;Build 2
  1. ;
  1. ; Global Variables
  1. ; ^LEX(757) SACC 1.3
  1. ; ^LEX(757.01) SACC 1.3
  1. ; ^LEX(757.011) SACC 1.3
  1. ; ^LEX(757.21) SACC 1.3
  1. ; ^LEXT(757.2) SACC 1.3
  1. ; ^TMP("LEXRX",$J) SACC 2.3.2.5.1
  1. ; ^TMP("LEXRXF",$J) SACC 2.3.2.5.1
  1. ; ^TMP("LEXTKN",$J) SACC 2.3.2.5.1
  1. ; ^TMP("LEXWRD",$J) SACC 2.3.2.5.1
  1. ;
  1. ; External References
  1. ; FILE^DID ICR 2052
  1. ; ^DIK ICR 10013
  1. ; IXALL^DIK ICR 10013
  1. ; $$FMDIFF^XLFDT ICR 10103
  1. ; $$NOW^XLFDT ICR 10103
  1. ; $$UP^XLFSTR ICR 10104
  1. ;
  1. ; Local Variables NEWed or KILLed Elsewhere
  1. ; LEXFIX Fix Index flag NEWed/KILLed by LEXRXXT
  1. ; LEXNAM Task name NEWed/KILLed by LEXRXXT
  1. ; LEXQ Quiet flat NEWed/KILLed by LEXRXXT2
  1. ; LEXSET Re-Index flag NEWed/KILLed by LEXRXXT
  1. ; LEXTEST Test variable NEWed/KILLed by Developer
  1. ; ZTQUEUED Task flag NEWed/KILLed by Taskman
  1. ; ZTREQ Task Reqest NEWed/KILLed by Taskman
  1. ;
  1. Q
  1. EN ; Main Entry Point
  1. R75721 ; Repair file 757.21
  1. K ^TMP("LEXRXF",$J) D RB,RC,RAA,SET K ^TMP("LEXRXF",$J)
  1. Q
  1. RB ; Index ^LEX(757.21,"B",EXP,IEN)
  1. N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSTR
  1. S LEXFI="757.21"
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.21 ""B""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.21,LEXIDX="B",LEXIDXT="^LEX(757.21,""B"",EXP,IEN)"
  1. F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
  1. . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
  1. . . S LEXNDS=LEXNDS+1 N LEXOK,LEXEX S LEXEX=$P($G(^LEX(LEXFI,LEXIEN,0)),"^",1)
  1. . . S LEXOK=0 S:LEXEX=LEXSTR LEXOK=1 I 'LEXOK D
  1. . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) S:$L(LEXEX) ^LEX(LEXFI,LEXIDX,LEXEX,LEXIEN)=""
  1. . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
  1. S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
  1. . N DA,DIK,X S DA=LEXIEN,X=$P($G(^LEX(LEXFI,DA,0)),"^",1) Q:'$L(X)
  1. . I '$D(^LEX(LEXFI,LEXIDX,X,DA)) D
  1. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",X,?58," ",DA
  1. . S:$L(X) ^LEX(LEXFI,LEXIDX,X,DA)=""
  1. S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
  1. H 1 S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
  1. S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
  1. D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
  1. Q
  1. RC ; Index ^LEX(757.21,"C",EXP,IEN)
  1. N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSTR
  1. S LEXFI="757.21"
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.21 ""C""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.21,LEXIDX="C",LEXIDXT="^LEX(757.21,""C"",EXP,IEN)"
  1. F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
  1. . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
  1. . . S LEXNDS=LEXNDS+1 N LEXOK,LEXEX,LEXEXP
  1. . . S LEXEX=$P($G(^LEX(LEXFI,LEXIEN,0)),"^",1)
  1. . . S LEXEXP=$E($$UP^XLFSTR($G(^LEX(757.01,+($G(LEXEX)),0))),1,63)
  1. . . S LEXOK=0 S:LEXEXP=LEXSTR LEXOK=1 I 'LEXOK D
  1. . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,"C",LEXSTR,LEXIEN) S:$L(LEXEXP) ^LEX(LEXFI,"C",LEXEXP,LEXIEN)=""
  1. . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,$E(LEXSTR,1,28),?58," ",LEXIEN
  1. S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
  1. . N DA,DIK,X,LEXEXP S DA=LEXIEN,X=$P($G(^LEX(LEXFI,DA,0)),"^",1),LEXEXP=$E($$UP^XLFSTR(^LEX(757.01,X,0)),1,63)
  1. . Q:+X'>0 Q:'$L(LEXEXP)
  1. . I '$D(^LEX(LEXFI,LEXIDX,LEXEXP,DA)) D
  1. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",$E(LEXEXP,1,20),?58," ",DA
  1. . S ^LEX(LEXFI,LEXIDX,LEXEXP,DA)=""
  1. S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
  1. H 1 S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
  1. S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
  1. D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
  1. Q
  1. RAA ; Index ^LEX(757.21,("A"_SUBSET),WORD,IEN)
  1. ; ^LEX(757.21,"ADEN",WORD,IEN)
  1. ; ^LEX(757.21,"AIMM",WORD,IEN)
  1. ; ^LEX(757.21,"ANUR",WORD,IEN)
  1. ; ^LEX(757.21,"ASOC",WORD,IEN)
  1. ; ^LEX(757.21,[etc],WORD,IEN)
  1. ;
  1. S:$D(ZTQUEUED) ZTREQ="@" N LEXARY,LEXBEG,LEXCT,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT
  1. N LEXIEN,LEXIT,LEXKEY,LEXKEYS,LEXMIS,LEXND,LEXSERR,LEXSIEN,LEXSNDS,LEXSTR,LEXTC,LEXTIM,X
  1. S LEXFI="757.21" K ^TMP("LEXRXF",$J) S:'$L($G(LEXNAM)) LEXNAM="LEXRXONE"
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.21 ""AA""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXSNDS)=0,LEXSTR="",LEXFI=757.21,LEXIDX=" "
  1. S LEXFI=757.21,(LEXMIS,LEXIT)=0,LEXIDX="A" F S LEXIDX=$O(^LEX(757.21,LEXIDX)) Q:'$L(LEXIDX) D Q:LEXIT>0
  1. . K ^TMP("LEXRXF",$J,LEXIDX) Q:$E(LEXIDX,1)'="A" Q:$L(LEXIDX)'=4
  1. . N LEXTC,LEXSTR,LEXCT,LEXBEG,LEXEND,LEXTIM,LEXERR,LEXNDS
  1. . S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Repairing File #757.21 """_LEXIDX_""""))
  1. . S (LEXNDS,LEXERR)=0,LEXTIM="",LEXBEG=$$NOW^XLFDT,LEXSTR="",LEXCT=0
  1. . I '$D(ZTQUEUED) W !,"^LEX(757.21,""",LEXIDX,""")"
  1. . F S LEXSTR=$O(^LEX(757.21,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
  1. . . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(757.21,LEXIDX,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
  1. . . . N LEXEXI S LEXEXI=+($G(^LEX(757.21,+LEXIEN,0)))
  1. . . . S LEXSNDS=+($G(LEXSNDS))+1,LEXNDS=+($G(LEXNDS))+1,^TMP("LEXRXF",$J,LEXIDX,"N")=LEXNDS,LEXCT=LEXCT+1
  1. . . . I '$D(^LEX(757.21,LEXIEN,0)) D Q
  1. . . . . S LEXERR=+($G(LEXERR))+1,^TMP("LEXRXF",$J,LEXIDX,"E")=LEXERR
  1. . . . . K:'$D(LEXTEST) ^LEX(757.21,LEXIDX,LEXSTR,LEXIEN)
  1. . . . . I '$D(ZTQUEUED) W !,?8,757.21,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
  1. . . . N LEXKEY,LEXKEYS,LEXDEA,LEXTTYP S LEXDEA=$$DEA(+LEXEXI) Q:+LEXDEA>0
  1. . . . S LEXTTYP=$P($G(^LEX(757.01,+LEXEXI,1)),"^",2) Q:LEXTTYP=8
  1. . . . K LEXKEYS D KEYS(LEXIEN,.LEXKEYS,LEXIDX)
  1. . . . I '$D(LEXKEYS(LEXSTR)) D Q
  1. . . . . S LEXERR=+($G(LEXERR))+1,^TMP("LEXRXF",$J,LEXIDX,"E")=LEXERR
  1. . . . . K:'$D(LEXTEST) ^LEX(757.21,LEXIDX,LEXSTR,LEXIEN)
  1. . . . . I '$D(ZTQUEUED) W !,?8,757.21,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
  1. . . . S LEXKEY="" F S LEXKEY=$O(LEXKEYS(LEXKEY)) Q:'$L(LEXKEY) D
  1. . . . . N LEXND S LEXND="^LEX(757.21,"""_LEXIDX_""","""_LEXKEY_""","_+LEXIEN_")"
  1. . . . . I '$D(@LEXND) S LEXMIS=+($G(LEXMIS))+1,LEXERR=+($G(LEXERR))+1,^TMP("LEXRXF",$J,LEXIDX,"E")=LEXERR
  1. . . . . S:'$D(LEXTEST) @LEXND=""
  1. . . . . W:'$D(ZTQUEUED)&('$D(@LEXND)) !,$J(LEXCT,6),?15,LEXND S @LEXND=""
  1. . I '$D(ZTQUEUED),+($G(LEXCT))>0 D
  1. . . I +($G(LEXERR))'>0 W ?22,$J(+($G(LEXCT)),12)," Tested"
  1. . . I +($G(LEXERR))>0 W !,?22,$J(+($G(LEXCT)),12),"/",+($G(LEXERR))," Tested/Errors"
  1. . H 1 S LEXEND=$$NOW^XLFDT,LEXTIM=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
  1. . S:$E(LEXTIM,1)=" "&($E(LEXTIM,3)=":") LEXTIM=$TR(LEXTIM," ","0")
  1. . S ^TMP("LEXRXF",$J,LEXIDX,"T")=LEXTIM
  1. H 1 S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
  1. ;
  1. N LEXSIEN S LEXSIEN=0 F S LEXSIEN=$O(^LEX(757.12,LEXSIEN)) Q:+LEXSIEN'>0 D
  1. . N LEXEX,LEXSS,LEXSSN,LEXKEY,LEXKEYS
  1. . S LEXSS=+($P($G(^LEX(757.21,+LEXSIEN,0)),"^",2))
  1. . S LEXSSN=$P($G(^LEXT(757.2,+LEXSS,5)),"^",2) Q:$L(LEXSSN)'=3 S LEXSSN="A"_LEXSSN
  1. . K LEXKEYS D KEYS(LEXSIEN,.LEXKEYS,LEXSSN)
  1. . S LEXKEY="" F S LEXKEY=$O(LEXKEYS(LEXKEY)) Q:'$L(LEXKEY) D
  1. . . S ^LEX(757.21,LEXSSN,LEXKEY,LEXSIEN)=""
  1. ;
  1. S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
  1. S (LEXSNDS,LEXSERR)=0,LEXIDX=" " F S LEXIDX=$O(^LEX(757.21,LEXIDX)) Q:'$L(LEXIDX) D
  1. . Q:$L(LEXIDX)'>1 N LEXE,LEXN S LEXE=$G(^TMP("LEXRXF",$J,LEXIDX,"E")),LEXSERR=LEXSERR+LEXE
  1. . S LEXN=$G(^TMP("LEXRXF",$J,LEXIDX,"N")),LEXSNDS=LEXSNDS+LEXN
  1. D REP^LEXRXXS(LEXFI,LEXFI,"A***",LEXSNDS,LEXSERR,"^LEX(757.21,""A***"",WORD,IEN)",LEXELP)
  1. S LEXIDX=" " F S LEXIDX=$O(^LEX(757.21,LEXIDX)) Q:'$L(LEXIDX) D
  1. . Q:$L(LEXIDX)>1 N LEXE,LEXN S LEXE=$G(^TMP("LEXRXF",$J,LEXIDX,"E")),LEXSERR=LEXSERR+LEXE
  1. . S LEXN=$G(^TMP("LEXRXF",$J,LEXIDX,"N")),LEXSNDS=LEXSNDS+LEXN
  1. S ^TMP("LEXRX",$J,"TERR")=+($G(LEXSERR))
  1. S LEXIDX=" " F S LEXIDX=$O(^LEX(757.21,LEXIDX)) Q:'$L(LEXIDX) D
  1. . Q:LEXIDX="B" Q:LEXIDX="C"
  1. . N LEXFI,LEXERR,LEXELP,LEXNDS,LEXIDXT S LEXFI=757.21
  1. . S LEXERR=$G(^TMP("LEXRXF",$J,LEXIDX,"E"))
  1. . S LEXNDS=$G(^TMP("LEXRXF",$J,LEXIDX,"N"))
  1. . S LEXELP=$G(^TMP("LEXRXF",$J,LEXIDX,"T"))
  1. . S LEXIDXT="^LEX(757.21,"""_LEXIDX_""",WORD,IEN)"
  1. . S LEXERR=$S(+($G(LEXERR))>0:LEXERR,1:"")
  1. . S LEXNDS=$S(+($G(LEXNDS))>0:LEXNDS,1:"")
  1. . S LEXELP=$S($L($G(LEXELP))>0:LEXELP,1:"")
  1. . D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
  1. K ^TMP("LEXRXF",$J)
  1. Q
  1. ;
  1. ; Miscellaneous
  1. KEYS(X,LEXARY,LEXIDX) ; Parse Sub-Set Expression into Keywords
  1. N LEXSI,LEXEXI,LEXEXP,LEXI,LEXIEN,LEXK,LEXMC,LEXSIEN K LEXARY
  1. S LEXSI=+($G(X)) Q:+LEXSI'>0 Q:'$D(^LEX(757.21,+LEXSI,0))
  1. S LEXIDX=$G(LEXIDX) Q:'$L(LEXIDX) Q:$L(LEXIDX)'=4 Q:$E(LEXIDX,1)'="A"
  1. S LEXIEN=+($G(^LEX(757.21,+LEXSI,0))) Q:'$D(^LEX(757.01,+LEXIEN,0))
  1. S LEXMC=+($G(^LEX(757.01,LEXIEN,1))) Q:LEXMC'>0 Q:'$D(^LEX(757,+LEXMC,0))
  1. S LEXEXI=0 F S LEXEXI=$O(^LEX(757.01,"AMC",+LEXMC,LEXEXI)) Q:+LEXEXI'>0 D
  1. . N X,LEXEXP,LEXTTYP,LEXDEA,LEXI S LEXDEA=$$DEA(+LEXEXI) Q:+($G(LEXDEA))>0
  1. . S LEXTTYP=+($P($G(^LEX(757.01,+LEXEXI,1)),"^",2)) Q:LEXTTYP=8
  1. . S (X,LEXEXP)=$G(^LEX(757.01,+LEXEXI,0)) K ^TMP("LEXTKN",$J) D PTX^LEXTOKN
  1. . S LEXI=0 F S LEXI=$O(^TMP("LEXTKN",$J,LEXI)) Q:+LEXI'>0 D
  1. . . S:$L($O(^TMP("LEXTKN",$J,LEXI,""))) LEXARY($O(^TMP("LEXTKN",$J,LEXI,"")))=""
  1. . I $D(^LEX(757.01,+LEXEXI,5,"B")) D SUP(+LEXEXI,.LEXARY)
  1. . I $D(^LEX(757.05,"AEXP",+LEXEXI)) D REP(+LEXEXI,.LEXARY)
  1. K ^TMP("LEXTKN",$J)
  1. Q
  1. SUP(X,LEXARY) ; Supplemental Keywords
  1. I $D(^LEX(757.01,+($G(X)),5,"B")) D
  1. . N LEXK S LEXK="" F S LEXK=$O(^LEX(757.01,+($G(X)),5,"B",LEXK)) Q:'$L(LEXK) S LEXARY(LEXK)=""
  1. Q
  1. REP(X,LEXARY) ; Repacement/Linked Keywords
  1. N LEXEXI,LEXLIEN,LEXSTR S LEXEXI=+($G(X)),LEXSTR="" I +LEXEXI>0 D
  1. . S LEXLIEN=0 F S LEXLIEN=$O(^LEX(757.05,"AEXP",+LEXEXI,LEXLIEN)) Q:+LEXLIEN'>0 D
  1. . . Q:'$D(^LEX(757.05,+LEXLIEN,1,"B",+LEXEXI)) N LEXN,LEXT,LEXE,LEXA
  1. . . S LEXN=$G(^LEX(757.05,+LEXLIEN,0)),LEXT=$P(LEXN,"^",1),LEXE=$P(LEXN,"^",2),LEXA=$P(LEXN,"^",3)
  1. . . Q:LEXA'="L" S:$L(LEXT) LEXARY(LEXT)=""
  1. Q
  1. SET ; Re-Index Subset file 757.21 (Set logic only)
  1. Q:'$D(LEXSET) N LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
  1. N LEXOUT,LEXMSG S LEXFI=757.21
  1. D FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
  1. S LEXRT=$G(LEXOUT("GLOBAL NAME")) Q:LEXRT'["^LEX"
  1. S LEXPRE=$G(^TMP("LEXRX",$J,"T",1,"ELAP"))
  1. S LEXBEG=$$NOW^XLFDT,LEXNM=$$FN^LEXRXXM(LEXFI)
  1. S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI))
  1. Q:LEXTC=1 I '$D(ZTQUEUED) W !,?8,"Re-Indexing",!
  1. N LEXIEN,LEXP1,LEXP2,LEXP3,LEXP4 S (LEXP3,LEXP4,LEXIEN)=0
  1. S LEXP1=$P($G(^LEX(LEXFI,0)),"^",1),LEXP2=$P($G(^LEX(LEXFI,0)),"^",2)
  1. F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
  1. . D:$D(LEXFIX) FIX(LEXIEN) I $D(^LEX(LEXFI,+LEXIEN,0)) S LEXP3=LEXIEN,LEXP4=LEXP4+1
  1. S:LEXP3>0 $P(^LEX(LEXFI,0),"^",3)=LEXP3 S:LEXP4>0 $P(^LEX(LEXFI,0),"^",4)=LEXP4
  1. I +($G(LEXP4))>0 N DIK S DIK="^LEX(757.21," D IXALL^DIK
  1. Q:$D(LEXQ) H 1 S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
  1. S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
  1. D REP^LEXRXXS(LEXFI,LEXFI,"ALLIX",,,"Re-Index",LEXELP)
  1. S LEXELP=$$ADDT^LEXRXXM(LEXELP,LEXPRE)
  1. S ^TMP("LEXRX",$J,"T",1,"ELAP")=LEXELP
  1. Q
  1. FIX(X) ; Fix Deactivated Expressions in 757.21
  1. N DA,DIK,LEXEXP,LEXDFL Q:'$D(LEXFIX) S DA=+($G(X)) Q:+DA'>0 Q:'$D(^LEX(757.21,+DA,0))
  1. S LEXEXP=+$G(^LEX(757.21,+DA,0)) Q:+LEXEXP'>0
  1. S LEXDFL=$P($G(^LEX(757.01,+LEXEXP,1)),"^",5) Q:+LEXDFL'>0
  1. I $D(LEXFIX) S DIK="^LEX(757.21," D ^DIK
  1. Q
  1. TM(X,Y) ; Trim Character Y - Default " "
  1. S X=$G(X) Q:X="" X S Y=$G(Y) S:'$L(Y) Y=" " F Q:$E(X,1)'=Y S X=$E(X,2,$L(X))
  1. F Q:$E(X,$L(X))'=Y S X=$E(X,1,($L(X)-1))
  1. Q X
  1. CLR ; Clear
  1. N LEXFIX,LEXNAM,LEXQ,LEXSET,LEXTEST,ZTQUEUED,ZTREQ
  1. Q
  1. DEA(X) ; Expression/Concept Deactive
  1. N LEXA,LEXEA,LEXEIEN,LEXMA,LEXMIEN,LEXN S LEXEIEN=+($G(X)),LEXN=$G(^LEX(757.01,+LEXEIEN,1))
  1. S LEXEA=+($P(LEXN,"^",5)),LEXMIEN=+LEXN,LEXN=+($P(LEXN,"^",2)) Q:LEXN=1&(LEXEA>0) 1 Q:LEXN=1&(LEXEA'>0) 0
  1. S LEXMIEN=+($G(^LEX(757,+LEXMIEN,0))),LEXMA=+($P($G(^LEX(757.01,+LEXMIEN,1)),"^",5)) Q:(LEXEA+LEXMA)>0 1
  1. Q 0