LEXRXD ;ISL/KER - Re-Index 757.02 B/ACODE/ACT ;04/21/2014
;;2.0;LEXICON UTILITY;**81,80**;Sep 23, 1996;Build 10
;
; Global Variables
; ^LEX( SACC 1.3
; ^LEX(757.02) SACC 1.3
; ^TMP("LEXRX") SACC 2.3.2.5.1
;
; External References
; $$FMDIFF^XLFDT ICR 10103
; $$NOW^XLFDT ICR 10103
; FILE^DID ICR 2052
; IX1^DIK ICR 10013
; ^DIM ICR 10016
;
; Local Variables NEWed or KILLed Elsewhere
; LEXNAM Task name NEWed/KILLed by LEXRXXT
; LEXSET Re-Index flag NEWed/KILLed by LEXRXXT
; LEXTEST Test variable NEWed/KILLed by Developer
; LEXQ Quiet flat NEWed/KILLed by LEXRXXT2
; ZTQUEUED Task flag NEWed/KILLed by Taskman
;
Q
EN ; Main Entry Point
R75702 ; Repair file 757.02
D RB,RACODE,RACT,R75702^LEXRXD2,R75702^LEXRXD3,R75702^LEXRXD4,SET
Q
RB ; Index ^LEX(757.02,"B",EXP,IEN)
; ^LEX(757.02,IEN,4,"B",EFF,IEN2)
N DA,DIK,LEXBEG,LEXDIF,LEXED,LEXELP,LEXEND,LEXERR,LEXEXP,LEXFI,LEXIDX,LEXIDXT,LEXIDST,LEXIEN,LEXMC,LEXNDS,LEXNDSS,LEXOK,LEXS,LEXSER,LEXSTR
S LEXFI="757.02"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.02 ""B""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXNDSS,LEXERR,LEXSER)=0,LEXSTR="",LEXFI="757.02",LEXIDX="B",LEXIDXT="^LEX(757.02,""B"",EXP,IEN)"
S LEXIDST="^LEX(757.02,IEN,4,""B"",EFF,IEN2)" 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,LEXEXP S LEXEXP=$P($G(^LEX(LEXFI,LEXIEN,0)),"^",1)
. . S LEXOK=0 S:LEXEXP=LEXSTR LEXOK=1
. . I 'LEXOK D
. . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
. . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
. . S:$L(LEXEXP) ^LEX(LEXFI,LEXIDX,LEXEXP,LEXIEN)=""
. . I $D(^LEX(LEXFI,LEXIEN,4)) D
. . . N LEXSTR S LEXSTR="" F S LEXSTR=$O(^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
. . . . N LEXS S LEXS=0 F S LEXS=$O(^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR,LEXS)) Q:+LEXS'>0 D
. . . . . S LEXNDSS=+($G(LEXNDSS))+1 N LEXOK,LEXED S LEXED=$P($G(^LEX(LEXFI,LEXIEN,4,LEXS,0)),"^",1)
. . . . . S LEXOK=0 S:LEXED=LEXSTR LEXOK=1
. . . . . I 'LEXOK D
. . . . . . S LEXSER=LEXSER+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR,LEXS)
. . . . . . I '$D(ZTQUEUED) W !,?10,757.28,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN,"/",LEXS
. . . . . S:$L(LEXED) ^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXED,LEXS)=""
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,X S X=$P($G(^LEX(LEXFI,LEXIEN,0)),"^",1) I $L(X) D
. . S DA=LEXIEN
. . 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)=""
. I $D(^LEX(LEXFI,LEXIEN,4)) D
. . N LEXS S LEXS=0 F S LEXS=$O(^LEX(LEXFI,LEXIEN,4,LEXS)) Q:+LEXS'>0 D
. . . N DA,X S DA(1)=LEXIEN,DA=LEXS,X=$P($G(^LEX(LEXFI,DA(1),4,DA,0)),"^",1) I $L(X) D
. . . . I '$D(^LEX(LEXFI,DA(1),4,LEXIDX,X,DA)) D
. . . . . S LEXSER=LEXSER+1 I '$D(ZTQUEUED) W !,?10,757.28,?19,LEXIDX,?30,"Missing ",X,?58," ",DA(1),"/",DA
. . . . S:$L(X) ^LEX(LEXFI,DA(1),4,LEXIDX,X,DA)=""
S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
S LEXSER=$S(+LEXSER>0:LEXSER,1:"") I '$D(ZTQUEUED) W !,$J(LEXSER,5),?10,757.28,?19,LEXIDX,?30,LEXIDST
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)
D REP^LEXRXXS(LEXFI,757.28,LEXIDX,LEXNDSS,LEXSER,LEXIDST)
Q
RACODE ; Index ^LEX(757.02,"ACODE",CODE,IEN)
N DA,DIK,LEXBEG,LEXDF,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXSTR
S LEXFI="757.02"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.02 ""ACODE""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.02,LEXIDX="ACODE",LEXIDXT="^LEX(757.02,""ACODE"",CODE,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,LEXDF,LEXSO S LEXDF=+$P($G(^LEX(757.02,LEXIEN,0)),U,6)
. . S LEXSO=$P($G(^LEX(757.02,LEXIEN,0)),U,2)
. . K:'$D(LEXTEST)&(+LEXDF>0) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) Q:+LEXDF>0
. . S LEXOK=0 S:(LEXSO_" ")=LEXSTR LEXOK=1 I 'LEXOK D
. . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) S:+LEXDF'>0&($L(LEXSO)) ^LEX(LEXFI,LEXIDX,(LEXSO_" "),LEXIEN)=""
. . . I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. Q:+($P($G(^LEX(LEXFI,LEXIEN,0)),"^",6))>0
. N DA,X S DA=LEXIEN,X=$P($G(^LEX(LEXFI,DA,0)),"^",2) 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 ^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
RACT ; Index ^LEX(757.02,"ACT",CODE,STA,DATE,IEN,HIS)
N DA,DIK,LEXBEG,LEXDIF,LEXDT,LEXEF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDT,LEXIDX,LEXIDXT,LEXIEN,LEXIHS,LEXISO,LEXIST,LEXN0,LEXN1
N LEXN1X,LEXN2,LEXN2X,LEXNDS,LEXNH,LEXNI,LEXNIX,LEXPF,LEXSO,LEXST,LEXTS,X
S LEXFI="757.02"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.02 ""ACT""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXFI=757.02,LEXIDX="ACT",LEXISO="",LEXIDXT="^LEX(757.02,""ACT"",CODE,ST,DT,IEN,HIS)"
F S LEXISO=$O(^LEX(LEXFI,LEXIDX,LEXISO)) Q:'$L(LEXISO) D
. N LEXIST S LEXIST="" F S LEXIST=$O(^LEX(LEXFI,LEXIDX,LEXISO,LEXIST)) Q:'$L(LEXIST) D
. . N LEXIDT S LEXIDT=0 F S LEXIDT=$O(^LEX(LEXFI,LEXIDX,LEXISO,LEXIST,LEXIDT)) Q:+LEXIDT'>0 D
. . . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXISO,LEXIST,LEXIDT,LEXIEN)) Q:+LEXIEN'>0 D
. . . . N LEXIHS S LEXIHS=0 F S LEXIHS=$O(^LEX(LEXFI,LEXIDX,LEXISO,LEXIST,LEXIDT,LEXIEN,LEXIHS)) Q:+LEXIHS'>0 D
. . . . . S LEXNDS=LEXNDS+1 N LEXSO,LEXST,LEXTS,LEXDT,LEXPF,LEXN0,LEXNH,LEXEF,LEXNI,LEXNIX,LEXN1,LEXN1X,LEXN2,LEXN2X S LEXEF=0
. . . . . S LEXN0=$G(^LEX(757.02,LEXIEN,0)),LEXNH=$G(^LEX(757.02,LEXIEN,4,LEXIHS,0))
. . . . . S LEXSO=$P(LEXN0,U,2),LEXPF=$P(LEXN0,U,5),LEXDT=$P(LEXNH,U,1),LEXST=$P(LEXNH,U,2)
. . . . . S LEXTS=LEXST S:+LEXPF>0 LEXTS=LEXTS+2
. . . . . S LEXNI="^LEX("_LEXFI_","""_LEXIDX_""","""_LEXISO_""","_LEXIST_","_LEXIDT_","_LEXIEN_","_LEXIHS_")"
. . . . . S LEXN1="^LEX("_LEXFI_","""_LEXIDX_""","""_LEXSO_" "","_LEXST_","_LEXDT_","_LEXIEN_","_LEXIHS_")"
. . . . . S LEXN2="^LEX("_LEXFI_","""_LEXIDX_""","""_LEXSO_" "","_LEXTS_","_LEXDT_","_LEXIEN_","_LEXIHS_")"
. . . . . S X="K "_LEXNI D ^DIM Q:'$L($G(X)) S LEXNIX=$G(X)
. . . . . S X="S "_LEXN1_"=""""" D ^DIM Q:'$L($G(X)) S LEXN1X=$G(X)
. . . . . S X="S "_LEXN2_"=""""" D ^DIM Q:'$L($G(X)) S LEXN2X=$G(X)
. . . . . X:'$D(LEXTEST)&(LEXNI'=LEXN1)&(LEXNI'=LEXN2) LEXNIX
. . . . . I LEXNI'=LEXN1,LEXNI'=LEXN2 D
. . . . . . S LEXERR=LEXERR+1
. . . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSO,?58," ",LEXIEN W:+LEXIHS>0 "/",+LEXIHS
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N LEXIHS S LEXIHS=0 F S LEXIHS=$O(^LEX(LEXFI,LEXIEN,4,LEXIHS)) Q:+LEXIHS'>0 D
. . N DA,DIK,LEXSO,LEXPF,LEXDT,LEXST,LEXTS S DA(1)=LEXIEN,DA=LEXIHS
. . S LEXSO=$P($G(^LEX(LEXFI,DA(1),0)),U,2),LEXPF=$P($G(^LEX(LEXFI,DA(1),0)),U,5)
. . S LEXDT=$P($G(^LEX(LEXFI,DA(1),4,DA,0)),U,1) Q:LEXDT'?7N S LEXST=$P($G(^LEX(LEXFI,DA(1),4,DA,0)),U,2) Q:LEXST'?1N
. . S LEXTS=LEXST S:+LEXPF>0 LEXTS=LEXTS+2
. . I '$D(^LEX(LEXFI,LEXIDX,(LEXSO_" "),+LEXST,+LEXDT,DA(1),DA)) D
. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXST,"/",LEXDT,?58," ",DA(1),"/",DA
. . I LEXTS>LEXST,'$D(^LEX(LEXFI,LEXIDX,(LEXSO_" "),+LEXTS,+LEXDT,DA(1),DA)) D
. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXTS,"/",LEXDT,?58," ",DA(1),"/",DA
. . S:$L(LEXSO)&($L(LEXST))&($L(LEXDT)) ^LEX(LEXFI,LEXIDX,(LEXSO_" "),+LEXST,+LEXDT,DA(1),DA)=""
. . I LEXTS>LEXST S:$L(LEXSO)&($L(LEXTS))&($L(LEXDT)) ^LEX(LEXFI,LEXIDX,(LEXSO_" "),+LEXTS,+LEXDT,DA(1),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
;
; Miscellaneous
SET ; Re-Index (Set logic only)
Q:'$D(LEXSET) N LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
N LEXOUT,LEXMSG S LEXFI=757.02
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
. S LEXP3=LEXIEN,LEXP4=LEXP4+1
. N DA,DIK S DA=LEXIEN,DIK=LEXRT D IX1^DIK
S $P(^LEX(LEXFI,0),"^",3)=LEXP3,$P(^LEX(LEXFI,0),"^",4)=LEXP4
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
CLR ; Clear
K LEXNAM,LEXSET,LEXTEST,ZTQUEUED,LEXQ
Q
LEXRXD ;ISL/KER - Re-Index 757.02 B/ACODE/ACT ;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.02) SACC 1.3
+6 ; ^TMP("LEXRX") SACC 2.3.2.5.1
+7 ;
+8 ; External References
+9 ; $$FMDIFF^XLFDT ICR 10103
+10 ; $$NOW^XLFDT ICR 10103
+11 ; FILE^DID ICR 2052
+12 ; IX1^DIK ICR 10013
+13 ; ^DIM ICR 10016
+14 ;
+15 ; Local Variables NEWed or KILLed Elsewhere
+16 ; LEXNAM Task name NEWed/KILLed by LEXRXXT
+17 ; LEXSET Re-Index flag NEWed/KILLed by LEXRXXT
+18 ; LEXTEST Test variable NEWed/KILLed by Developer
+19 ; LEXQ Quiet flat NEWed/KILLed by LEXRXXT2
+20 ; ZTQUEUED Task flag NEWed/KILLed by Taskman
+21 ;
+22 QUIT
EN ; Main Entry Point
R75702 ; Repair file 757.02
+1 DO RB
DO RACODE
DO RACT
DO R75702^LEXRXD2
DO R75702^LEXRXD3
DO R75702^LEXRXD4
DO SET
+2 QUIT
RB ; Index ^LEX(757.02,"B",EXP,IEN)
+1 ; ^LEX(757.02,IEN,4,"B",EFF,IEN2)
+2 NEW DA,DIK,LEXBEG,LEXDIF,LEXED,LEXELP,LEXEND,LEXERR,LEXEXP,LEXFI,LEXIDX,LEXIDXT,LEXIDST,LEXIEN,LEXMC,LEXNDS,LEXNDSS,LEXOK,LEXS,LEXSER,LEXSTR
+3 SET LEXFI="757.02"
+4 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.02 ""B""")
IF LEXTC=1
QUIT
+5 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXNDSS,LEXERR,LEXSER)=0
SET LEXSTR=""
SET LEXFI="757.02"
SET LEXIDX="B"
SET LEXIDXT="^LEX(757.02,""B"",EXP,IEN)"
+6 SET LEXIDST="^LEX(757.02,IEN,4,""B"",EFF,IEN2)"
FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
IF '$LENGTH(LEXSTR)
QUIT
Begin DoDot:1
+7 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:2
+8 SET LEXNDS=LEXNDS+1
NEW LEXOK,LEXEXP
SET LEXEXP=$PIECE($GET(^LEX(LEXFI,LEXIEN,0)),"^",1)
+9 SET LEXOK=0
IF LEXEXP=LEXSTR
SET LEXOK=1
+10 IF 'LEXOK
Begin DoDot:3
+11 SET LEXERR=LEXERR+1
IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
+12 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
End DoDot:3
+13 IF $LENGTH(LEXEXP)
SET ^LEX(LEXFI,LEXIDX,LEXEXP,LEXIEN)=""
+14 IF $DATA(^LEX(LEXFI,LEXIEN,4))
Begin DoDot:3
+15 NEW LEXSTR
SET LEXSTR=""
FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR))
IF '$LENGTH(LEXSTR)
QUIT
Begin DoDot:4
+16 NEW LEXS
SET LEXS=0
FOR
SET LEXS=$ORDER(^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR,LEXS))
IF +LEXS'>0
QUIT
Begin DoDot:5
+17 SET LEXNDSS=+($GET(LEXNDSS))+1
NEW LEXOK,LEXED
SET LEXED=$PIECE($GET(^LEX(LEXFI,LEXIEN,4,LEXS,0)),"^",1)
+18 SET LEXOK=0
IF LEXED=LEXSTR
SET LEXOK=1
+19 IF 'LEXOK
Begin DoDot:6
+20 SET LEXSER=LEXSER+1
IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR,LEXS)
+21 IF '$DATA(ZTQUEUED)
WRITE !,?10,757.28,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN,"/",LEXS
End DoDot:6
+22 IF $LENGTH(LEXED)
SET ^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXED,LEXS)=""
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:1
+24 NEW DA,X
SET X=$PIECE($GET(^LEX(LEXFI,LEXIEN,0)),"^",1)
IF $LENGTH(X)
Begin DoDot:2
+25 SET DA=LEXIEN
+26 IF '$DATA(^LEX(LEXFI,LEXIDX,X,DA))
Begin DoDot:3
+27 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",X,?58," ",DA
End DoDot:3
+28 IF $LENGTH(X)
SET ^LEX(LEXFI,LEXIDX,X,DA)=""
End DoDot:2
+29 IF $DATA(^LEX(LEXFI,LEXIEN,4))
Begin DoDot:2
+30 NEW LEXS
SET LEXS=0
FOR
SET LEXS=$ORDER(^LEX(LEXFI,LEXIEN,4,LEXS))
IF +LEXS'>0
QUIT
Begin DoDot:3
+31 NEW DA,X
SET DA(1)=LEXIEN
SET DA=LEXS
SET X=$PIECE($GET(^LEX(LEXFI,DA(1),4,DA,0)),"^",1)
IF $LENGTH(X)
Begin DoDot:4
+32 IF '$DATA(^LEX(LEXFI,DA(1),4,LEXIDX,X,DA))
Begin DoDot:5
+33 SET LEXSER=LEXSER+1
IF '$DATA(ZTQUEUED)
WRITE !,?10,757.28,?19,LEXIDX,?30,"Missing ",X,?58," ",DA(1),"/",DA
End DoDot:5
+34 IF $LENGTH(X)
SET ^LEX(LEXFI,DA(1),4,LEXIDX,X,DA)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+35 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+36 SET LEXSER=$SELECT(+LEXSER>0:LEXSER,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXSER,5),?10,757.28,?19,LEXIDX,?30,LEXIDST
+37 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+38 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+39 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+40 DO REP^LEXRXXS(LEXFI,757.28,LEXIDX,LEXNDSS,LEXSER,LEXIDST)
+41 QUIT
RACODE ; Index ^LEX(757.02,"ACODE",CODE,IEN)
+1 NEW DA,DIK,LEXBEG,LEXDF,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXSTR
+2 SET LEXFI="757.02"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.02 ""ACODE""")
IF LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXSTR=""
SET LEXFI=757.02
SET LEXIDX="ACODE"
SET LEXIDXT="^LEX(757.02,""ACODE"",CODE,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,LEXDF,LEXSO
SET LEXDF=+$PIECE($GET(^LEX(757.02,LEXIEN,0)),U,6)
+8 SET LEXSO=$PIECE($GET(^LEX(757.02,LEXIEN,0)),U,2)
+9 IF '$DATA(LEXTEST)&(+LEXDF>0)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
IF +LEXDF>0
QUIT
+10 SET LEXOK=0
IF (LEXSO_" ")=LEXSTR
SET LEXOK=1
IF 'LEXOK
Begin DoDot:3
+11 SET LEXERR=LEXERR+1
IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
IF +LEXDF'>0&($LENGTH(LEXSO))
SET ^LEX(LEXFI,LEXIDX,(LEXSO_" "),LEXIEN)=""
+12 IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?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 IF +($PIECE($GET(^LEX(LEXFI,LEXIEN,0)),"^",6))>0
QUIT
+15 NEW DA,X
SET DA=LEXIEN
SET X=$PIECE($GET(^LEX(LEXFI,DA,0)),"^",2)
IF '$LENGTH(X)
QUIT
+16 IF '$DATA(^LEX(LEXFI,LEXIDX,(X_" "),DA))
Begin DoDot:2
+17 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",X,?58," ",DA
End DoDot:2
+18 SET ^LEX(LEXFI,LEXIDX,(X_" "),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
RACT ; Index ^LEX(757.02,"ACT",CODE,STA,DATE,IEN,HIS)
+1 NEW DA,DIK,LEXBEG,LEXDIF,LEXDT,LEXEF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDT,LEXIDX,LEXIDXT,LEXIEN,LEXIHS,LEXISO,LEXIST,LEXN0,LEXN1
+2 NEW LEXN1X,LEXN2,LEXN2X,LEXNDS,LEXNH,LEXNI,LEXNIX,LEXPF,LEXSO,LEXST,LEXTS,X
+3 SET LEXFI="757.02"
+4 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.02 ""ACT""")
IF LEXTC=1
QUIT
+5 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXFI=757.02
SET LEXIDX="ACT"
SET LEXISO=""
SET LEXIDXT="^LEX(757.02,""ACT"",CODE,ST,DT,IEN,HIS)"
+6 FOR
SET LEXISO=$ORDER(^LEX(LEXFI,LEXIDX,LEXISO))
IF '$LENGTH(LEXISO)
QUIT
Begin DoDot:1
+7 NEW LEXIST
SET LEXIST=""
FOR
SET LEXIST=$ORDER(^LEX(LEXFI,LEXIDX,LEXISO,LEXIST))
IF '$LENGTH(LEXIST)
QUIT
Begin DoDot:2
+8 NEW LEXIDT
SET LEXIDT=0
FOR
SET LEXIDT=$ORDER(^LEX(LEXFI,LEXIDX,LEXISO,LEXIST,LEXIDT))
IF +LEXIDT'>0
QUIT
Begin DoDot:3
+9 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXISO,LEXIST,LEXIDT,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:4
+10 NEW LEXIHS
SET LEXIHS=0
FOR
SET LEXIHS=$ORDER(^LEX(LEXFI,LEXIDX,LEXISO,LEXIST,LEXIDT,LEXIEN,LEXIHS))
IF +LEXIHS'>0
QUIT
Begin DoDot:5
+11 SET LEXNDS=LEXNDS+1
NEW LEXSO,LEXST,LEXTS,LEXDT,LEXPF,LEXN0,LEXNH,LEXEF,LEXNI,LEXNIX,LEXN1,LEXN1X,LEXN2,LEXN2X
SET LEXEF=0
+12 SET LEXN0=$GET(^LEX(757.02,LEXIEN,0))
SET LEXNH=$GET(^LEX(757.02,LEXIEN,4,LEXIHS,0))
+13 SET LEXSO=$PIECE(LEXN0,U,2)
SET LEXPF=$PIECE(LEXN0,U,5)
SET LEXDT=$PIECE(LEXNH,U,1)
SET LEXST=$PIECE(LEXNH,U,2)
+14 SET LEXTS=LEXST
IF +LEXPF>0
SET LEXTS=LEXTS+2
+15 SET LEXNI="^LEX("_LEXFI_","""_LEXIDX_""","""_LEXISO_""","_LEXIST_","_LEXIDT_","_LEXIEN_","_LEXIHS_")"
+16 SET LEXN1="^LEX("_LEXFI_","""_LEXIDX_""","""_LEXSO_" "","_LEXST_","_LEXDT_","_LEXIEN_","_LEXIHS_")"
+17 SET LEXN2="^LEX("_LEXFI_","""_LEXIDX_""","""_LEXSO_" "","_LEXTS_","_LEXDT_","_LEXIEN_","_LEXIHS_")"
+18 SET X="K "_LEXNI
DO ^DIM
IF '$LENGTH($GET(X))
QUIT
SET LEXNIX=$GET(X)
+19 SET X="S "_LEXN1_"="""""
DO ^DIM
IF '$LENGTH($GET(X))
QUIT
SET LEXN1X=$GET(X)
+20 SET X="S "_LEXN2_"="""""
DO ^DIM
IF '$LENGTH($GET(X))
QUIT
SET LEXN2X=$GET(X)
+21 IF '$DATA(LEXTEST)&(LEXNI'=LEXN1)&(LEXNI'=LEXN2)
XECUTE LEXNIX
+22 IF LEXNI'=LEXN1
IF LEXNI'=LEXN2
Begin DoDot:6
+23 SET LEXERR=LEXERR+1
+24 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSO,?58," ",LEXIEN
IF +LEXIHS>0
WRITE "/",+LEXIHS
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+25 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:1
+26 NEW LEXIHS
SET LEXIHS=0
FOR
SET LEXIHS=$ORDER(^LEX(LEXFI,LEXIEN,4,LEXIHS))
IF +LEXIHS'>0
QUIT
Begin DoDot:2
+27 NEW DA,DIK,LEXSO,LEXPF,LEXDT,LEXST,LEXTS
SET DA(1)=LEXIEN
SET DA=LEXIHS
+28 SET LEXSO=$PIECE($GET(^LEX(LEXFI,DA(1),0)),U,2)
SET LEXPF=$PIECE($GET(^LEX(LEXFI,DA(1),0)),U,5)
+29 SET LEXDT=$PIECE($GET(^LEX(LEXFI,DA(1),4,DA,0)),U,1)
IF LEXDT'?7N
QUIT
SET LEXST=$PIECE($GET(^LEX(LEXFI,DA(1),4,DA,0)),U,2)
IF LEXST'?1N
QUIT
+30 SET LEXTS=LEXST
IF +LEXPF>0
SET LEXTS=LEXTS+2
+31 IF '$DATA(^LEX(LEXFI,LEXIDX,(LEXSO_" "),+LEXST,+LEXDT,DA(1),DA))
Begin DoDot:3
+32 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXST,"/",LEXDT,?58," ",DA(1),"/",DA
End DoDot:3
+33 IF LEXTS>LEXST
IF '$DATA(^LEX(LEXFI,LEXIDX,(LEXSO_" "),+LEXTS,+LEXDT,DA(1),DA))
Begin DoDot:3
+34 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXTS,"/",LEXDT,?58," ",DA(1),"/",DA
End DoDot:3
+35 IF $LENGTH(LEXSO)&($LENGTH(LEXST))&($LENGTH(LEXDT))
SET ^LEX(LEXFI,LEXIDX,(LEXSO_" "),+LEXST,+LEXDT,DA(1),DA)=""
+36 IF LEXTS>LEXST
IF $LENGTH(LEXSO)&($LENGTH(LEXTS))&($LENGTH(LEXDT))
SET ^LEX(LEXFI,LEXIDX,(LEXSO_" "),+LEXTS,+LEXDT,DA(1),DA)=""
End DoDot:2
End DoDot:1
+37 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+38 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+39 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+40 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+41 QUIT
+42 ;
+43 ; Miscellaneous
SET ; Re-Index (Set logic only)
+1 IF '$DATA(LEXSET)
QUIT
NEW LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
+2 NEW LEXOUT,LEXMSG
SET LEXFI=757.02
+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 SET LEXP3=LEXIEN
SET LEXP4=LEXP4+1
+12 NEW DA,DIK
SET DA=LEXIEN
SET DIK=LEXRT
DO IX1^DIK
End DoDot:1
+13 SET $PIECE(^LEX(LEXFI,0),"^",3)=LEXP3
SET $PIECE(^LEX(LEXFI,0),"^",4)=LEXP4
+14 IF $DATA(LEXQ)
QUIT
SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+15 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+16 DO REP^LEXRXXS(LEXFI,LEXFI,"ALLIX",,,"Re-Index",LEXELP)
+17 SET LEXELP=$$ADDT^LEXRXXM(LEXELP,LEXPRE)
+18 SET ^TMP("LEXRX",$JOB,"T",1,"ELAP")=LEXELP
+19 QUIT
CLR ; Clear
+1 KILL LEXNAM,LEXSET,LEXTEST,ZTQUEUED,LEXQ
+2 QUIT
