- LEXRXF ;ISL/KER - Re-Index 757.21 B/C/AA ;04/21/2014
- ;;2.0;LEXICON UTILITY;**81,80**;Sep 23, 1996;Build 10
- ;
- ; Global Variables
- ; ^LEX( SACC 1.3
- ; ^LEX(757) SACC 1.3
- ; ^LEX(757.01) SACC 1.3
- ; ^LEX(757.011) SACC 1.3
- ; ^LEX(757.21) SACC 1.3
- ; ^LEXT(757.2) SACC 1.3
- ; ^TMP("LEXRX") SACC 2.3.2.5.1
- ; ^TMP("LEXRXF") SACC 2.3.2.5.1
- ; ^TMP("LEXTKN") SACC 2.3.2.5.1
- ; ^TMP("LEXWRD") SACC 2.3.2.5.1
- ;
- ; External References
- ; $$FMDIFF^XLFDT ICR 10103
- ; $$NOW^XLFDT ICR 10103
- ; $$UP^XLFSTR ICR 10104
- ; FILE^DID ICR 2052
- ; IX1^DIK ICR 10013
- ; IX1^DIK ICR 10013
- ;
- ; Local Variables NEWed or KILLed Elsewhere
- ; LEXFIX Fix Index flag NEWed/KILLed by LEXRXXT
- ; LEXNAM Task name NEWed/KILLed by LEXRXXT
- ; LEXSET Re-Index flag NEWed/KILLed by LEXRXXT
- ; LEXQ Quiet flat NEWed/KILLed by LEXRXXT2
- ; LEXTEST Test variable NEWed/KILLed by Developer
- ; ZTQUEUED Task flag NEWed/KILLed by Taskman
- ;
- Q
- EN ; Main Entry Point
- R75721 ; Repair file 757.21
- K ^TMP("LEXRXF",$J) D RB,RC,RAA,SET K ^TMP("LEXRXF",$J)
- Q
- RB ; Index ^LEX(757.21,"B",EXP,IEN)
- N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSTR
- S LEXFI="757.21"
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.21 ""B""") Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.21,LEXIDX="B",LEXIDXT="^LEX(757.21,""B"",EXP,IEN)"
- F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
- . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
- . . S LEXNDS=LEXNDS+1 N LEXOK,LEXEX S LEXEX=$P($G(^LEX(LEXFI,LEXIEN,0)),"^",1)
- . . S LEXOK=0 S:LEXEX=LEXSTR LEXOK=1 I 'LEXOK D
- . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) S:$L(LEXEX) ^LEX(LEXFI,LEXIDX,LEXEX,LEXIEN)=""
- . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
- S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
- . N DA,DIK,X S DA=LEXIEN,X=$P($G(^LEX(LEXFI,DA,0)),"^",1) Q:'$L(X)
- . I '$D(^LEX(LEXFI,LEXIDX,X,DA)) D
- . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",X,?58," ",DA
- . S:$L(X) ^LEX(LEXFI,LEXIDX,X,DA)=""
- S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
- S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
- D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
- Q
- RC ; Index ^LEX(757.21,"C",EXP,IEN)
- N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSTR
- S LEXFI="757.21"
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.21 ""C""") Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.21,LEXIDX="C",LEXIDXT="^LEX(757.21,""C"",EXP,IEN)"
- F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
- . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
- . . S LEXNDS=LEXNDS+1 N LEXOK,LEXEX,LEXEXP
- . . S LEXEX=$P($G(^LEX(LEXFI,LEXIEN,0)),"^",1)
- . . S LEXEXP=$E($$UP^XLFSTR($G(^LEX(757.01,+($G(LEXEX)),0))),1,63)
- . . S LEXOK=0 S:LEXEXP=LEXSTR LEXOK=1 I 'LEXOK D
- . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,"C",LEXSTR,LEXIEN) S:$L(LEXEXP) ^LEX(LEXFI,"C",LEXEXP,LEXIEN)=""
- . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,$E(LEXSTR,1,28),?58," ",LEXIEN
- S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
- . 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)
- . Q:+X'>0 Q:'$L(LEXEXP)
- . I '$D(^LEX(LEXFI,LEXIDX,LEXEXP,DA)) D
- . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",$E(LEXEXP,1,20),?58," ",DA
- . S ^LEX(LEXFI,LEXIDX,LEXEXP,DA)=""
- S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
- S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
- D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
- Q
- RAA ; Index ^LEX(757.21,("A"_SUBSET),WORD,IEN)
- ; ^LEX(757.21,"ADEN",WORD,IEN)
- ; ^LEX(757.21,"AIMM",WORD,IEN)
- ; ^LEX(757.21,"ANUR",WORD,IEN)
- ; ^LEX(757.21,"ASOC",WORD,IEN)
- ; ^LEX(757.21,[etc],WORD,IEN)
- N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXEX,LEXEXI,LEXELP,LEXEXP,LEXEXPS,LEXFI,LEXI,LEXID,LEXIDX,LEXIDXT,LEXIEN,LEXJ
- N LEXMC,LEXNDS,LEXOK,LEXSIDX,LEXSTR,LEXT,LEXTY,LEXW,LEXDENE,LEXIMME,LEXNURE,LEXSOCE,LEXDENN,LEXIMMN,LEXNURN,LEXSOCN,X
- S LEXFI="757.21" K ^TMP("LEXRXF",$J)
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.21 ""AA""") Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT,(LEXNDS)=0,LEXSTR="",LEXFI=757.21,LEXIDX=" "
- S LEXIDX=" " F S LEXIDX=$O(^LEX(757.21,LEXIDX)) Q:'$L(LEXIDX) D
- . Q:LEXIDX="B" Q:LEXIDX="C" Q:LEXIDX?1N.N
- . S LEXIDXT="^LEX(757.21,"""_LEXIDX_""",WORD,IEN)"
- . N LEXBEG,LEXEND,LEXTIM,LEXERR,LEXNDS,LEXELP
- . S LEXERR=$G(^TMP("LEXRXF",$J,LEXIDX,"E"))
- . S LEXNDS=$G(^TMP("LEXRXF",$J,LEXIDX,"N"))
- . S LEXELP=$G(^TMP("LEXRXF",$J,LEXIDX,"T"))
- . S LEXBEG=$$NOW^XLFDT H 2
- . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
- . N LEXTNG,LEXTC S LEXFI="757.21",LEXTNG="Repairing"
- . I +($G(LEXFI))>0,$D(ZTQUEUED) D Q:LEXTC=1
- . . S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Repairing File #757.21 """_LEXIDX_""""))
- . F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
- . . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
- . . . S LEXNDS=+($G(LEXNDS))+1,^TMP("LEXRXF",$J,LEXIDX,"N")=LEXNDS
- . . . I '$D(^LEX(757.21,LEXIEN,0)) D Q
- . . . . S LEXERR=+($G(LEXERR))+1,^TMP("LEXRXF",$J,LEXIDX,"E")=LEXERR
- . . . . K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
- . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
- . . . N LEXI,LEXIX K LEXEXPS
- . . . S LEXEX=+($G(^LEX(757.21,LEXIEN,0)))
- . . . S LEXMC=$P(^LEX(757.01,LEXEX,1),U,1)
- . . . S LEXID=$P($G(^LEX(757.21,LEXIEN,0)),U,2)
- . . . S LEXID=$P(^LEXT(757.2,LEXID,0),U,2) S:$L(LEXID) LEXID="A"_LEXID Q:'$L(LEXID)
- . . . S LEXEXI=0 F S LEXEXI=$O(^LEX(757.01,"AMC",LEXMC,LEXEXI)) Q:+LEXEXI'>0 D
- . . . . N LEXTY,LEXT,LEXW,LEXJ,LEXEXP,LEXSIDX S LEXEXP=$G(^LEX(757.01,LEXEXI,0))
- . . . . S LEXTY=+($P($G(^LEX(757.01,LEXEXI,1)),U,2)) Q:LEXTY'>0
- . . . . S LEXT=+($P($G(^LEX(757.011,LEXTY,0)),"^",2)) Q:LEXT=0
- . . . . S LEXSIDX=LEXID K ^TMP("LEXTKN",$J) S X=LEXEXP,LEXIX=LEXIDX,LEXIDX="" D PTX^LEXTOKN S LEXIDX=LEXIX
- . . . . I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 D
- . . . . . N LEXI S LEXI=0 F S LEXI=$O(^TMP("LEXTKN",$J,LEXI)) Q:+LEXI'>0 D
- . . . . . . N LEXW S LEXW=$O(^TMP("LEXTKN",$J,LEXI,"")) Q:'$L(LEXW) S LEXEXPS(LEXID,LEXW,LEXIEN)=""
- . . . . K ^TMP("LEXTKN",$J)
- . . . I $L(LEXIDX),$L(LEXSTR),$L(LEXIEN) D
- . . . . I '$D(LEXEXPS(LEXIDX,LEXSTR,LEXIEN)) D
- . . . . . S LEXERR=+($G(LEXERR))+1,^TMP("LEXRXF",$J,LEXIDX,"E")=LEXERR
- . . . . . K:'$D(LEXTEST) ^LEX(757.21,LEXIDX,LEXSTR,LEXIEN)
- . . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
- . . . . . N LEXW S LEXW="" F S LEXW=$O(LEXEXPS(LEXIDX,LEXW)) Q:'$L(LEXW) D
- . . . . . . N LEXI S LEXI=0 F S LEXI=$O(LEXEXPS(LEXIDX,LEXW,LEXI)) Q:+LEXI'>0 D
- . . . . . . . S ^LEX(757.21,LEXID,LEXW,LEXI)=""
- . . . K LEXEXPS
- . S LEXEND=$$NOW^XLFDT,LEXTIM=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- . S:$E(LEXTIM,1)=" "&($E(LEXTIM,3)=":") LEXTIM=$TR(LEXTIM," ","0")
- . S ^TMP("LEXRXF",$J,LEXIDX,"T")=LEXTIM
- I '$D(ZTQUEUED) W !,?8,"Check for missing records"
- N LEXIEN,LEXNDS,LEXBEG,LEXEND,LEXELP,LEXMIS
- S LEXBEG=$$NOW^XLFDT,LEXNDS=0,LEXMIS=0
- S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
- . N DA,LEXIX,LEXAIX,LEXERR,LEXEXP,LEXMC,LEXTEXP,LEXW S DA=LEXIEN
- . S LEXIX=$P($G(^LEX(LEXFI,DA,0)),"^",2),LEXIX=$P($G(^LEXT(757.2,+LEXIX,0)),"^",2)
- . S LEXAIX="A"_LEXIX
- . S LEXERR=$G(^TMP("LEXRXF",$J,LEXAIX,"E"))
- . K ^TMP("LEXWRD",$J)
- . S LEXEXP=+(^LEX(757.21,DA,0)),LEXMC=$P(^LEX(757.01,LEXEXP,1),U,1)
- . K ^TMP("LEXTKN",$J),^TMP("LEXWRD",$J)
- . S LEXNDS=LEXNDS+1
- . S LEXTEXP=0 F S LEXTEXP=$O(^LEX(757.01,"AMC",LEXMC,LEXTEXP)) Q:+LEXTEXP=0 D
- . . N X,LEXIDX,LEXYPE,LEXT,LEXJ S X=$G(^LEX(757.01,LEXTEXP,0)),LEXIDX="" Q:'$L(X)
- . . S LEXYPE=+($P($G(^LEX(757.01,LEXTEXP,1)),U,2)) Q:LEXYPE'>0
- . . S LEXT=+($P($G(^LEX(757.011,LEXYPE,0)),"^",2)) Q:LEXT=0
- . . D PTX^LEXTOKN I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 F LEXJ=1:1:^TMP("LEXTKN",$J,0) D
- . . . N LEXW S LEXW=$O(^TMP("LEXTKN",$J,LEXJ,"")) S:$L(LEXW) ^TMP("LEXWRD",$J,LEXW)=""
- . . K ^TMP("LEXTKN",$J) Q
- . S LEXW="" F S LEXW=$O(^TMP("LEXWRD",$J,LEXW)) Q:'$L(LEXW) D
- . . I '$D(^LEX(LEXFI,LEXAIX,LEXW,DA)) D
- . . . S LEXMIS=LEXMIS+0
- . . . S LEXERR=+($G(LEXERR))+1,^TMP("LEXRXF",$J,LEXAIX,"E")=LEXERR
- . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXAIX,?30,"Missing ",$E(LEXW,1,18),?58," ",DA
- . . S:$L(LEXW)&(+DA>0)&($L(LEXAIX))&($L(LEXFI)) ^LEX(LEXFI,LEXAIX,LEXW,DA)=""
- . K ^TMP("LEXWRD",$J),^TMP("LEXTKN",$J)
- S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
- D REP^LEXRXXS(LEXFI,LEXFI,"AAAA",LEXNDS,LEXMIS,"^LEX(757.21,""ASUB"",WORD,IEN)",LEXELP)
- S LEXIDX=" " F S LEXIDX=$O(^LEX(757.21,LEXIDX)) Q:'$L(LEXIDX) D
- . Q:LEXIDX="B" Q:LEXIDX="C"
- . N LEXFI,LEXERR,LEXELP,LEXNDS,LEXIDXT S LEXFI=757.21
- . S LEXERR=$G(^TMP("LEXRXF",$J,LEXIDX,"E"))
- . S LEXNDS=$G(^TMP("LEXRXF",$J,LEXIDX,"N"))
- . S LEXELP=$G(^TMP("LEXRXF",$J,LEXIDX,"T"))
- . S LEXIDXT="^LEX(757.21,"""_LEXIDX_""",WORD,IEN)"
- . S LEXERR=$S(+($G(LEXERR))>0:LEXERR,1:"")
- . S LEXNDS=$S(+($G(LEXNDS))>0:LEXNDS,1:"")
- . S LEXELP=$S($L($G(LEXELP))>0:LEXELP,1:"")
- . D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
- K ^TMP("LEXRXF",$J)
- Q
- ;
- ; Miscellaneous
- SET ; Re-Index Subset file 757.21 (Set logic only)
- Q:'$D(LEXSET) N LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
- N LEXOUT,LEXMSG S LEXFI=757.21
- D FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
- S LEXRT=$G(LEXOUT("GLOBAL NAME")) Q:LEXRT'["^LEX"
- S LEXPRE=$G(^TMP("LEXRX",$J,"T",1,"ELAP"))
- S LEXBEG=$$NOW^XLFDT,LEXNM=$$FN^LEXRXXM(LEXFI)
- S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI))
- Q:LEXTC=1 I '$D(ZTQUEUED) W !,?8,"Re-Indexing",!
- N LEXIEN,LEXP3,LEXP4 S (LEXP3,LEXP4,LEXIEN)=0
- F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
- . N DA,DIK S DA=+($G(LEXIEN)) D:$D(LEXFIX) FIX(DA)
- . I $D(^LEX(LEXFI,+LEXIEN,0)) D
- . . S LEXP3=LEXIEN,LEXP4=LEXP4+1
- . . S DA=LEXIEN,DIK=LEXRT D IX1^DIK
- Q:$D(LEXQ) S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
- D REP^LEXRXXS(LEXFI,LEXFI,"ALLIX",,,"Re-Index",LEXELP)
- S LEXELP=$$ADDT^LEXRXXM(LEXELP,LEXPRE)
- S ^TMP("LEXRX",$J,"T",1,"ELAP")=LEXELP
- Q
- FIX(X) ; Fix Deactivated Expressions in 757.21
- N DA,DIK,LEXEXP,LEXDFL Q:'$D(LEXFIX) S DA=+($G(X)) Q:+DA'>0 Q:'$D(^LEX(757.21,+DA,0))
- S LEXEXP=+$G(^LEX(757.21,+DA,0)) Q:+LEXEXP'>0
- S LEXDFL=$P($G(^LEX(757.01,+LEXEXP,1)),"^",5) Q:+LEXDFL'>0
- I $D(LEXFIX) S DIK="^LEX(757.21," D ^DIK
- Q
- CLR ; Clear
- N LEXFIX,LEXNAM,LEXSET,LEXTEST,ZTQUEUED,LEXQ
- Q
- LEXRXF ;ISL/KER - Re-Index 757.21 B/C/AA ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**81,80**;Sep 23, 1996;Build 10
- +2 ;
- +3 ; Global Variables
- +4 ; ^LEX( SACC 1.3
- +5 ; ^LEX(757) SACC 1.3
- +6 ; ^LEX(757.01) SACC 1.3
- +7 ; ^LEX(757.011) SACC 1.3
- +8 ; ^LEX(757.21) SACC 1.3
- +9 ; ^LEXT(757.2) SACC 1.3
- +10 ; ^TMP("LEXRX") SACC 2.3.2.5.1
- +11 ; ^TMP("LEXRXF") SACC 2.3.2.5.1
- +12 ; ^TMP("LEXTKN") SACC 2.3.2.5.1
- +13 ; ^TMP("LEXWRD") SACC 2.3.2.5.1
- +14 ;
- +15 ; External References
- +16 ; $$FMDIFF^XLFDT ICR 10103
- +17 ; $$NOW^XLFDT ICR 10103
- +18 ; $$UP^XLFSTR ICR 10104
- +19 ; FILE^DID ICR 2052
- +20 ; IX1^DIK ICR 10013
- +21 ; IX1^DIK ICR 10013
- +22 ;
- +23 ; Local Variables NEWed or KILLed Elsewhere
- +24 ; LEXFIX Fix Index flag NEWed/KILLed by LEXRXXT
- +25 ; LEXNAM Task name NEWed/KILLed by LEXRXXT
- +26 ; LEXSET Re-Index flag NEWed/KILLed by LEXRXXT
- +27 ; LEXQ Quiet flat NEWed/KILLed by LEXRXXT2
- +28 ; LEXTEST Test variable NEWed/KILLed by Developer
- +29 ; ZTQUEUED Task flag NEWed/KILLed by Taskman
- +30 ;
- +31 QUIT
- EN ; Main Entry Point
- R75721 ; Repair file 757.21
- +1 KILL ^TMP("LEXRXF",$JOB)
- DO RB
- DO RC
- DO RAA
- DO SET
- KILL ^TMP("LEXRXF",$JOB)
- +2 QUIT
- RB ; Index ^LEX(757.21,"B",EXP,IEN)
- +1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSTR
- +2 SET LEXFI="757.21"
- +3 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.21 ""B""")
- IF LEXTC=1
- QUIT
- +4 SET LEXBEG=$$NOW^XLFDT
- SET (LEXNDS,LEXERR)=0
- SET LEXSTR=""
- SET LEXFI=757.21
- SET LEXIDX="B"
- SET LEXIDXT="^LEX(757.21,""B"",EXP,IEN)"
- +5 FOR
- SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
- IF '$LENGTH(LEXSTR)
- QUIT
- Begin DoDot:1
- +6 NEW LEXIEN
- SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN))
- IF +LEXIEN'>0
- QUIT
- Begin DoDot:2
- +7 SET LEXNDS=LEXNDS+1
- NEW LEXOK,LEXEX
- SET LEXEX=$PIECE($GET(^LEX(LEXFI,LEXIEN,0)),"^",1)
- +8 SET LEXOK=0
- IF LEXEX=LEXSTR
- SET LEXOK=1
- IF 'LEXOK
- Begin DoDot:3
- +9 SET LEXERR=LEXERR+1
- IF '$DATA(LEXTEST)
- KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
- IF $LENGTH(LEXEX)
- SET ^LEX(LEXFI,LEXIDX,LEXEX,LEXIEN)=""
- +10 IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +11 SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
- IF +LEXIEN'>0
- QUIT
- Begin DoDot:1
- +12 NEW DA,DIK,X
- SET DA=LEXIEN
- SET X=$PIECE($GET(^LEX(LEXFI,DA,0)),"^",1)
- IF '$LENGTH(X)
- QUIT
- +13 IF '$DATA(^LEX(LEXFI,LEXIDX,X,DA))
- Begin DoDot:2
- +14 SET LEXERR=LEXERR+1
- IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",X,?58," ",DA
- End DoDot:2
- +15 IF $LENGTH(X)
- SET ^LEX(LEXFI,LEXIDX,X,DA)=""
- End DoDot:1
- +16 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
- IF '$DATA(ZTQUEUED)
- WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
- +17 SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +18 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +19 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
- +20 QUIT
- RC ; Index ^LEX(757.21,"C",EXP,IEN)
- +1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSTR
- +2 SET LEXFI="757.21"
- +3 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.21 ""C""")
- IF LEXTC=1
- QUIT
- +4 SET LEXBEG=$$NOW^XLFDT
- SET (LEXNDS,LEXERR)=0
- SET LEXSTR=""
- SET LEXFI=757.21
- SET LEXIDX="C"
- SET LEXIDXT="^LEX(757.21,""C"",EXP,IEN)"
- +5 FOR
- SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
- IF '$LENGTH(LEXSTR)
- QUIT
- Begin DoDot:1
- +6 NEW LEXIEN
- SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN))
- IF +LEXIEN'>0
- QUIT
- Begin DoDot:2
- +7 SET LEXNDS=LEXNDS+1
- NEW LEXOK,LEXEX,LEXEXP
- +8 SET LEXEX=$PIECE($GET(^LEX(LEXFI,LEXIEN,0)),"^",1)
- +9 SET LEXEXP=$EXTRACT($$UP^XLFSTR($GET(^LEX(757.01,+($GET(LEXEX)),0))),1,63)
- +10 SET LEXOK=0
- IF LEXEXP=LEXSTR
- SET LEXOK=1
- IF 'LEXOK
- Begin DoDot:3
- +11 SET LEXERR=LEXERR+1
- IF '$DATA(LEXTEST)
- KILL ^LEX(LEXFI,"C",LEXSTR,LEXIEN)
- IF $LENGTH(LEXEXP)
- SET ^LEX(LEXFI,"C",LEXEXP,LEXIEN)=""
- +12 IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,$EXTRACT(LEXSTR,1,28),?58," ",LEXIEN
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +13 SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
- IF +LEXIEN'>0
- QUIT
- Begin DoDot:1
- +14 NEW DA,DIK,X,LEXEXP
- SET DA=LEXIEN
- SET X=$PIECE($GET(^LEX(LEXFI,DA,0)),"^",1)
- SET LEXEXP=$EXTRACT($$UP^XLFSTR(^LEX(757.01,X,0)),1,63)
- +15 IF +X'>0
- QUIT
- IF '$LENGTH(LEXEXP)
- QUIT
- +16 IF '$DATA(^LEX(LEXFI,LEXIDX,LEXEXP,DA))
- Begin DoDot:2
- +17 SET LEXERR=LEXERR+1
- IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",$EXTRACT(LEXEXP,1,20),?58," ",DA
- End DoDot:2
- +18 SET ^LEX(LEXFI,LEXIDX,LEXEXP,DA)=""
- End DoDot:1
- +19 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
- IF '$DATA(ZTQUEUED)
- WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
- +20 SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +21 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +22 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
- +23 QUIT
- RAA ; Index ^LEX(757.21,("A"_SUBSET),WORD,IEN)
- +1 ; ^LEX(757.21,"ADEN",WORD,IEN)
- +2 ; ^LEX(757.21,"AIMM",WORD,IEN)
- +3 ; ^LEX(757.21,"ANUR",WORD,IEN)
- +4 ; ^LEX(757.21,"ASOC",WORD,IEN)
- +5 ; ^LEX(757.21,[etc],WORD,IEN)
- +6 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXEX,LEXEXI,LEXELP,LEXEXP,LEXEXPS,LEXFI,LEXI,LEXID,LEXIDX,LEXIDXT,LEXIEN,LEXJ
- +7 NEW LEXMC,LEXNDS,LEXOK,LEXSIDX,LEXSTR,LEXT,LEXTY,LEXW,LEXDENE,LEXIMME,LEXNURE,LEXSOCE,LEXDENN,LEXIMMN,LEXNURN,LEXSOCN,X
- +8 SET LEXFI="757.21"
- KILL ^TMP("LEXRXF",$JOB)
- +9 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.21 ""AA""")
- IF LEXTC=1
- QUIT
- +10 SET LEXBEG=$$NOW^XLFDT
- SET (LEXNDS)=0
- SET LEXSTR=""
- SET LEXFI=757.21
- SET LEXIDX=" "
- +11 SET LEXIDX=" "
- FOR
- SET LEXIDX=$ORDER(^LEX(757.21,LEXIDX))
- IF '$LENGTH(LEXIDX)
- QUIT
- Begin DoDot:1
- +12 IF LEXIDX="B"
- QUIT
- IF LEXIDX="C"
- QUIT
- IF LEXIDX?1N.N
- QUIT
- +13 SET LEXIDXT="^LEX(757.21,"""_LEXIDX_""",WORD,IEN)"
- +14 NEW LEXBEG,LEXEND,LEXTIM,LEXERR,LEXNDS,LEXELP
- +15 SET LEXERR=$GET(^TMP("LEXRXF",$JOB,LEXIDX,"E"))
- +16 SET LEXNDS=$GET(^TMP("LEXRXF",$JOB,LEXIDX,"N"))
- +17 SET LEXELP=$GET(^TMP("LEXRXF",$JOB,LEXIDX,"T"))
- +18 SET LEXBEG=$$NOW^XLFDT
- HANG 2
- +19 IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
- +20 NEW LEXTNG,LEXTC
- SET LEXFI="757.21"
- SET LEXTNG="Repairing"
- +21 IF +($GET(LEXFI))>0
- IF $DATA(ZTQUEUED)
- Begin DoDot:2
- +22 SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Repairing File #757.21 """_LEXIDX_""""))
- End DoDot:2
- IF LEXTC=1
- QUIT
- +23 FOR
- SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
- IF '$LENGTH(LEXSTR)
- QUIT
- Begin DoDot:2
- +24 NEW LEXIEN
- SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN))
- IF +LEXIEN'>0
- QUIT
- Begin DoDot:3
- +25 SET LEXNDS=+($GET(LEXNDS))+1
- SET ^TMP("LEXRXF",$JOB,LEXIDX,"N")=LEXNDS
- +26 IF '$DATA(^LEX(757.21,LEXIEN,0))
- Begin DoDot:4
- +27 SET LEXERR=+($GET(LEXERR))+1
- SET ^TMP("LEXRXF",$JOB,LEXIDX,"E")=LEXERR
- +28 IF '$DATA(LEXTEST)
- KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
- +29 IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
- End DoDot:4
- QUIT
- +30 NEW LEXI,LEXIX
- KILL LEXEXPS
- +31 SET LEXEX=+($GET(^LEX(757.21,LEXIEN,0)))
- +32 SET LEXMC=$PIECE(^LEX(757.01,LEXEX,1),U,1)
- +33 SET LEXID=$PIECE($GET(^LEX(757.21,LEXIEN,0)),U,2)
- +34 SET LEXID=$PIECE(^LEXT(757.2,LEXID,0),U,2)
- IF $LENGTH(LEXID)
- SET LEXID="A"_LEXID
- IF '$LENGTH(LEXID)
- QUIT
- +35 SET LEXEXI=0
- FOR
- SET LEXEXI=$ORDER(^LEX(757.01,"AMC",LEXMC,LEXEXI))
- IF +LEXEXI'>0
- QUIT
- Begin DoDot:4
- +36 NEW LEXTY,LEXT,LEXW,LEXJ,LEXEXP,LEXSIDX
- SET LEXEXP=$GET(^LEX(757.01,LEXEXI,0))
- +37 SET LEXTY=+($PIECE($GET(^LEX(757.01,LEXEXI,1)),U,2))
- IF LEXTY'>0
- QUIT
- +38 SET LEXT=+($PIECE($GET(^LEX(757.011,LEXTY,0)),"^",2))
- IF LEXT=0
- QUIT
- +39 SET LEXSIDX=LEXID
- KILL ^TMP("LEXTKN",$JOB)
- SET X=LEXEXP
- SET LEXIX=LEXIDX
- SET LEXIDX=""
- DO PTX^LEXTOKN
- SET LEXIDX=LEXIX
- +40 IF $DATA(^TMP("LEXTKN",$JOB,0))
- IF ^TMP("LEXTKN",$JOB,0)>0
- Begin DoDot:5
- +41 NEW LEXI
- SET LEXI=0
- FOR
- SET LEXI=$ORDER(^TMP("LEXTKN",$JOB,LEXI))
- IF +LEXI'>0
- QUIT
- Begin DoDot:6
- +42 NEW LEXW
- SET LEXW=$ORDER(^TMP("LEXTKN",$JOB,LEXI,""))
- IF '$LENGTH(LEXW)
- QUIT
- SET LEXEXPS(LEXID,LEXW,LEXIEN)=""
- End DoDot:6
- End DoDot:5
- +43 KILL ^TMP("LEXTKN",$JOB)
- End DoDot:4
- +44 IF $LENGTH(LEXIDX)
- IF $LENGTH(LEXSTR)
- IF $LENGTH(LEXIEN)
- Begin DoDot:4
- +45 IF '$DATA(LEXEXPS(LEXIDX,LEXSTR,LEXIEN))
- Begin DoDot:5
- +46 SET LEXERR=+($GET(LEXERR))+1
- SET ^TMP("LEXRXF",$JOB,LEXIDX,"E")=LEXERR
- +47 IF '$DATA(LEXTEST)
- KILL ^LEX(757.21,LEXIDX,LEXSTR,LEXIEN)
- +48 IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
- +49 NEW LEXW
- SET LEXW=""
- FOR
- SET LEXW=$ORDER(LEXEXPS(LEXIDX,LEXW))
- IF '$LENGTH(LEXW)
- QUIT
- Begin DoDot:6
- +50 NEW LEXI
- SET LEXI=0
- FOR
- SET LEXI=$ORDER(LEXEXPS(LEXIDX,LEXW,LEXI))
- IF +LEXI'>0
- QUIT
- Begin DoDot:7
- +51 SET ^LEX(757.21,LEXID,LEXW,LEXI)=""
- End DoDot:7
- End DoDot:6
- End DoDot:5
- End DoDot:4
- +52 KILL LEXEXPS
- End DoDot:3
- End DoDot:2
- +53 SET LEXEND=$$NOW^XLFDT
- SET LEXTIM=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +54 IF $EXTRACT(LEXTIM,1)=" "&($EXTRACT(LEXTIM,3)="
- SET LEXTIM=$TRANSLATE(LEXTIM," ","0")
- +55 SET ^TMP("LEXRXF",$JOB,LEXIDX,"T")=LEXTIM
- End DoDot:1
- +56 IF '$DATA(ZTQUEUED)
- WRITE !,?8,"Check for missing records"
- +57 NEW LEXIEN,LEXNDS,LEXBEG,LEXEND,LEXELP,LEXMIS
- +58 SET LEXBEG=$$NOW^XLFDT
- SET LEXNDS=0
- SET LEXMIS=0
- +59 SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
- IF +LEXIEN'>0
- QUIT
- Begin DoDot:1
- +60 NEW DA,LEXIX,LEXAIX,LEXERR,LEXEXP,LEXMC,LEXTEXP,LEXW
- SET DA=LEXIEN
- +61 SET LEXIX=$PIECE($GET(^LEX(LEXFI,DA,0)),"^",2)
- SET LEXIX=$PIECE($GET(^LEXT(757.2,+LEXIX,0)),"^",2)
- +62 SET LEXAIX="A"_LEXIX
- +63 SET LEXERR=$GET(^TMP("LEXRXF",$JOB,LEXAIX,"E"))
- +64 KILL ^TMP("LEXWRD",$JOB)
- +65 SET LEXEXP=+(^LEX(757.21,DA,0))
- SET LEXMC=$PIECE(^LEX(757.01,LEXEXP,1),U,1)
- +66 KILL ^TMP("LEXTKN",$JOB),^TMP("LEXWRD",$JOB)
- +67 SET LEXNDS=LEXNDS+1
- +68 SET LEXTEXP=0
- FOR
- SET LEXTEXP=$ORDER(^LEX(757.01,"AMC",LEXMC,LEXTEXP))
- IF +LEXTEXP=0
- QUIT
- Begin DoDot:2
- +69 NEW X,LEXIDX,LEXYPE,LEXT,LEXJ
- SET X=$GET(^LEX(757.01,LEXTEXP,0))
- SET LEXIDX=""
- IF '$LENGTH(X)
- QUIT
- +70 SET LEXYPE=+($PIECE($GET(^LEX(757.01,LEXTEXP,1)),U,2))
- IF LEXYPE'>0
- QUIT
- +71 SET LEXT=+($PIECE($GET(^LEX(757.011,LEXYPE,0)),"^",2))
- IF LEXT=0
- QUIT
- +72 DO PTX^LEXTOKN
- IF $DATA(^TMP("LEXTKN",$JOB,0))
- IF ^TMP("LEXTKN",$JOB,0)>0
- FOR LEXJ=1:1:^TMP("LEXTKN",$JOB,0)
- Begin DoDot:3
- +73 NEW LEXW
- SET LEXW=$ORDER(^TMP("LEXTKN",$JOB,LEXJ,""))
- IF $LENGTH(LEXW)
- SET ^TMP("LEXWRD",$JOB,LEXW)=""
- End DoDot:3
- +74 KILL ^TMP("LEXTKN",$JOB)
- QUIT
- End DoDot:2
- +75 SET LEXW=""
- FOR
- SET LEXW=$ORDER(^TMP("LEXWRD",$JOB,LEXW))
- IF '$LENGTH(LEXW)
- QUIT
- Begin DoDot:2
- +76 IF '$DATA(^LEX(LEXFI,LEXAIX,LEXW,DA))
- Begin DoDot:3
- +77 SET LEXMIS=LEXMIS+0
- +78 SET LEXERR=+($GET(LEXERR))+1
- SET ^TMP("LEXRXF",$JOB,LEXAIX,"E")=LEXERR
- +79 IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXAIX,?30,"Missing ",$EXTRACT(LEXW,1,18),?58," ",DA
- End DoDot:3
- +80 IF $LENGTH(LEXW)&(+DA>0)&($LENGTH(LEXAIX))&($LENGTH(LEXFI))
- SET ^LEX(LEXFI,LEXAIX,LEXW,DA)=""
- End DoDot:2
- +81 KILL ^TMP("LEXWRD",$JOB),^TMP("LEXTKN",$JOB)
- End DoDot:1
- +82 SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +83 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +84 DO REP^LEXRXXS(LEXFI,LEXFI,"AAAA",LEXNDS,LEXMIS,"^LEX(757.21,""ASUB"",WORD,IEN)",LEXELP)
- +85 SET LEXIDX=" "
- FOR
- SET LEXIDX=$ORDER(^LEX(757.21,LEXIDX))
- IF '$LENGTH(LEXIDX)
- QUIT
- Begin DoDot:1
- +86 IF LEXIDX="B"
- QUIT
- IF LEXIDX="C"
- QUIT
- +87 NEW LEXFI,LEXERR,LEXELP,LEXNDS,LEXIDXT
- SET LEXFI=757.21
- +88 SET LEXERR=$GET(^TMP("LEXRXF",$JOB,LEXIDX,"E"))
- +89 SET LEXNDS=$GET(^TMP("LEXRXF",$JOB,LEXIDX,"N"))
- +90 SET LEXELP=$GET(^TMP("LEXRXF",$JOB,LEXIDX,"T"))
- +91 SET LEXIDXT="^LEX(757.21,"""_LEXIDX_""",WORD,IEN)"
- +92 SET LEXERR=$SELECT(+($GET(LEXERR))>0:LEXERR,1:"")
- +93 SET LEXNDS=$SELECT(+($GET(LEXNDS))>0:LEXNDS,1:"")
- +94 SET LEXELP=$SELECT($LENGTH($GET(LEXELP))>0:LEXELP,1:"")
- +95 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
- End DoDot:1
- +96 KILL ^TMP("LEXRXF",$JOB)
- +97 QUIT
- +98 ;
- +99 ; Miscellaneous
- SET ; Re-Index Subset file 757.21 (Set logic only)
- +1 IF '$DATA(LEXSET)
- QUIT
- NEW LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
- +2 NEW LEXOUT,LEXMSG
- SET LEXFI=757.21
- +3 DO FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
- +4 SET LEXRT=$GET(LEXOUT("GLOBAL NAME"))
- IF LEXRT'["^LEX"
- QUIT
- +5 SET LEXPRE=$GET(^TMP("LEXRX",$JOB,"T",1,"ELAP"))
- +6 SET LEXBEG=$$NOW^XLFDT
- SET LEXNM=$$FN^LEXRXXM(LEXFI)
- +7 SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
- +8 IF LEXTC=1
- QUIT
- IF '$DATA(ZTQUEUED)
- WRITE !,?8,"Re-Indexing",!
- +9 NEW LEXIEN,LEXP3,LEXP4
- SET (LEXP3,LEXP4,LEXIEN)=0
- +10 FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
- IF +LEXIEN'>0
- QUIT
- Begin DoDot:1
- +11 NEW DA,DIK
- SET DA=+($GET(LEXIEN))
- IF $DATA(LEXFIX)
- DO FIX(DA)
- +12 IF $DATA(^LEX(LEXFI,+LEXIEN,0))
- Begin DoDot:2
- +13 SET LEXP3=LEXIEN
- SET LEXP4=LEXP4+1
- +14 SET DA=LEXIEN
- SET DIK=LEXRT
- DO IX1^DIK
- End DoDot:2
- End DoDot:1
- +15 IF $DATA(LEXQ)
- QUIT
- SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +16 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +17 DO REP^LEXRXXS(LEXFI,LEXFI,"ALLIX",,,"Re-Index",LEXELP)
- +18 SET LEXELP=$$ADDT^LEXRXXM(LEXELP,LEXPRE)
- +19 SET ^TMP("LEXRX",$JOB,"T",1,"ELAP")=LEXELP
- +20 QUIT
- FIX(X) ; Fix Deactivated Expressions in 757.21
- +1 NEW DA,DIK,LEXEXP,LEXDFL
- IF '$DATA(LEXFIX)
- QUIT
- SET DA=+($GET(X))
- IF +DA'>0
- QUIT
- IF '$DATA(^LEX(757.21,+DA,0))
- QUIT
- +2 SET LEXEXP=+$GET(^LEX(757.21,+DA,0))
- IF +LEXEXP'>0
- QUIT
- +3 SET LEXDFL=$PIECE($GET(^LEX(757.01,+LEXEXP,1)),"^",5)
- IF +LEXDFL'>0
- QUIT
- +4 IF $DATA(LEXFIX)
- SET DIK="^LEX(757.21,"
- DO ^DIK
- +5 QUIT
- CLR ; Clear
- +1 NEW LEXFIX,LEXNAM,LEXSET,LEXTEST,ZTQUEUED,LEXQ
- +2 QUIT